diff --git a/ChangeLog b/ChangeLog index b27215d493..f65bef2d74 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2001-05-05 Christian Stimming + + * src/scm/report/price-scatter.scm: More experiments with scatter + plots which are working now. Doesn't look too nice though. + + * src/scm/commodity-utilities.scm + (gnc:get-match-commodity-splits): new function. + + * src/scm/date-utilities.scm (gnc:date->timepair): new + function. Code cleanup. + + * src/guile/gnc.gwp: more price handling functions. + 2001-05-04 Dave Peticolas * src/register/splitreg.c: set action cell to autosize diff --git a/src/scm/commodity-utilities.scm b/src/scm/commodity-utilities.scm index eef26ff3ad..9681b78057 100644 --- a/src/scm/commodity-utilities.scm +++ b/src/scm/commodity-utilities.scm @@ -33,10 +33,12 @@ ;; the exchange rate for different commodities by determining the ;; weighted average of all currency transactions. -;; Returns a list of all splits in the currency-accounts up to -;; end-date which have two *different* commodities involved. -(define (gnc:get-all-commodity-splits - currency-accounts end-date-tp) +;; Returns a list of all splits in the 'currency-accounts' up to +;; 'end-date-tp' which have two different commodities involved, one of +;; which is equivalent to 'commodity' (the latter constraint only if +;; 'commodity' != #f ). +(define (gnc:get-match-commodity-splits + currency-accounts end-date-tp commodity) (let ((query (gnc:malloc-query)) (splits #f)) @@ -53,17 +55,33 @@ ;; Filter such that we get only those splits ;; which have two *different* commodities ;; involved. - (lambda (s) (not (gnc:commodity-equiv? - (gnc:transaction-get-commodity - (gnc:split-get-parent s)) - (gnc:account-get-commodity - (gnc:split-get-account s))))) + (lambda (s) (let ((trans-comm + (gnc:transaction-get-commodity + (gnc:split-get-parent s))) + (acc-comm + (gnc:account-get-commodity + (gnc:split-get-account s)))) + (and + (not (gnc:commodity-equiv? + trans-comm acc-comm)) + (or + commodity + (gnc:commodity-equiv? + commodity trans-comm) + (gnc:commodity-equiv? + commodity acc-comm))))) (gnc:glist->list (gnc:query-get-splits query) ))) (gnc:free-query query) splits)) +;; Returns a list of all splits in the currency-accounts up to +;; end-date which have two *different* commodities involved. +(define (gnc:get-all-commodity-splits + currency-accounts end-date-tp) + (gnc:get-match-commodity-splits currency-accounts end-date-tp #f)) + ;; Go through all toplevel non-report-commodity balances in sumlist ;; and add them to report-commodity, if possible. This function takes diff --git a/src/scm/date-utilities.scm b/src/scm/date-utilities.scm index 3d564ccdba..6f9c52aaf4 100644 --- a/src/scm/date-utilities.scm +++ b/src/scm/date-utilities.scm @@ -35,6 +35,9 @@ (define (gnc:timepair->date tp) (localtime (gnc:timepair->secs tp))) +(define (gnc:date->timepair date) + (gnc:secs->timepair (car (mktime date)))) + ;; get stuff from localtime date vector (define (gnc:date-get-year datevec) (+ 1900 (tm:year datevec))) @@ -145,8 +148,7 @@ (set-tm:mon newtm (op (tm:mon newtm) (tm:mon delta))) (set-tm:year newtm (op (tm:year newtm) (tm:year delta))) (set-tm:isdst newtm -1) - (let ((time (car (mktime newtm)))) - (cons time 0))))) + (gnc:date->timepair newtm)))) ;; Add or subtract time from a date (define (decdate adate delta)(moddate - adate delta )) @@ -307,8 +309,7 @@ (set-tm:min bdt 0) (set-tm:hour bdt 0) (set-tm:isdst bdt -1) - (let ((newtime (car (mktime bdt)))) - (cons newtime 0)))) + (gnc:date->timepair bdt))) (define (gnc:timepair-end-day-time tp) (let ((bdt (gnc:timepair->date tp))) @@ -316,8 +317,7 @@ (set-tm:min bdt 59) (set-tm:hour bdt 23) (set-tm:isdst bdt -1) - (let ((newtime (car (mktime bdt)))) - (cons newtime 0)))) + (gnc:date->timepair bdt))) (define (gnc:timepair-previous-day tp) (decdate tp DayDelta)) @@ -368,7 +368,7 @@ (set-tm:mday now 1) (set-tm:mon now 0) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now))))) + (gnc:date->timepair now))) (define (gnc:get-end-cal-year) (let ((now (localtime (current-time)))) @@ -378,7 +378,7 @@ (set-tm:mday now 31) (set-tm:mon now 11) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now))))) + (gnc:date->timepair now))) (define (gnc:get-start-prev-year) (let ((now (localtime (current-time)))) @@ -389,7 +389,7 @@ (set-tm:mon now 0) (set-tm:year now (- (tm:year now) 1)) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now))))) + (gnc:date->timepair now))) (define (gnc:get-end-prev-year) (let ((now (localtime (current-time)))) @@ -400,7 +400,7 @@ (set-tm:mon now 11) (set-tm:year now (- (tm:year now) 1)) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now))))) + (gnc:date->timepair now))) ;; FIXME:: Replace with option when it becomes available (define (gnc:get-start-cur-fin-year) @@ -414,7 +414,7 @@ (set-tm:mon now 6) (set-tm:year now (- (tm:year now) 1)) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now)))) + (gnc:date->timepair now)) (begin (set-tm:sec now 0) (set-tm:min now 0) @@ -422,7 +422,7 @@ (set-tm:mday now 1) (set-tm:mon now 6) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now))))))) + (gnc:date->timepair now))))) (define (gnc:get-start-prev-fin-year) (let ((now (localtime (current-time)))) @@ -435,7 +435,7 @@ (set-tm:mon now 6) (set-tm:year now (- (tm:year now) 2)) (set-tm:isdst now -1) - (cons (car (mktime now)) 0)) + (gnc:date->timepair now)) (begin (set-tm:sec now 0) (set-tm:min now 0) @@ -444,7 +444,7 @@ (set-tm:mon now 6) (set-tm:year now (- (tm:year now) 2)) (set-tm:isdst now -1) - (cons (car (mktime now)) 0))))) + (gnc:date->timepair now))))) (define (gnc:get-end-prev-fin-year) (let ((now (localtime (current-time)))) @@ -457,7 +457,7 @@ (set-tm:mon now 5) (set-tm:year now (- (tm:year now) 1)) (set-tm:isdst now -1) - (cons (car (mktime now)) 0)) + (gnc:date->timepair now)) (begin (set-tm:sec now 59) (set-tm:min now 59) @@ -465,7 +465,7 @@ (set-tm:mday now 30) (set-tm:mon now 5) (set-tm:isdst now -1) - (cons (car (mktime now)) 0))))) + (gnc:date->timepair now))))) (define (gnc:get-start-this-month) (let ((now (localtime (current-time)))) @@ -474,7 +474,7 @@ (set-tm:hour now 0) (set-tm:mday now 1) (set-tm:isdst now -1) - (cons (car (mktime now)) 0))) + (gnc:date->timepair now))) (define (gnc:get-end-this-month) (let ((now (localtime (current-time)))) @@ -484,7 +484,7 @@ (set-tm:mday now (gnc:days-in-month (+ (tm:mon now) 1) (+ (tm:year now) 1900))) (set-tm:isdst now -1) - (cons (car (mktime now)) 0))) + (gnc:date->timepair now))) (define (gnc:get-start-prev-month) (let ((now (localtime (current-time)))) @@ -498,7 +498,7 @@ (set-tm:year now (- (tm:year now) 1))) (set-tm:mon now (- (tm:mon now) 1))) (set-tm:isdst now -1) - (cons (car (mktime now)) 0))) + (gnc:date->timepair now))) (define (gnc:get-end-prev-month) (let ((now (localtime (current-time)))) @@ -513,7 +513,7 @@ (set-tm:mday now (gnc:days-in-month (+ (tm:mon now) 1) (+ (tm:year now) 1900))) (set-tm:isdst now -1) - (cons (car (mktime now)) 0))) + (gnc:date->timepair now))) (define (gnc:get-start-current-quarter) (let ((now (localtime (current-time)))) @@ -523,7 +523,7 @@ (set-tm:mday now 1) (set-tm:mon now (- (tm:mon now) (modulo (tm:mon now) 3))) (set-tm:isdst now -1) - (cons (car (mktime now)) 0))) + (gnc:date->timepair now))) (define (gnc:get-end-current-quarter) (let ((now (localtime (current-time)))) @@ -535,7 +535,7 @@ (set-tm:mday now (gnc:days-in-month (+ (tm:mon now) 1) (+ (tm:year now) 1900))) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now))))) + (gnc:date->timepair now))) (define (gnc:get-start-prev-quarter) (let ((now (localtime (current-time)))) @@ -550,7 +550,7 @@ (set-tm:year now (- (tm:year now) 1))) (set-tm:mon now (- (tm:mon now) 3))) (set-tm:isdst now -1) - (cons (car (mktime now)) 0))) + (gnc:date->timepair now))) (define (gnc:get-end-prev-quarter) (let ((now (localtime (current-time)))) @@ -566,7 +566,7 @@ (set-tm:mday now (gnc:days-in-month (+ (tm:mon now) 1) (+ (tm:year now) 1900))) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now))))) + (gnc:date->timepair now))) (define (gnc:get-today) (cons (current-time) 0)) @@ -583,7 +583,7 @@ (if (> month-length (tm:mday now)) (set-tm:mday now month-length)) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now)))))) + (gnc:date->timepair now)))) (define (gnc:get-three-months-ago) (let ((now (localtime (current-time)))) @@ -597,7 +597,7 @@ (if (> (month-days) (tm:mday now)) (set-tm:mday now month-days)) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now)))))) + (gnc:date->timepair now)))) (define (gnc:get-six-months-ago) (let ((now (localtime (current-time)))) @@ -611,7 +611,7 @@ (if (> (month-days) (tm:mday now)) (set-tm:mday now month-days)) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now)))))) + (gnc:date->timepair now)))) (define (gnc:get-one-year-ago) (let ((now (localtime (current-time)))) @@ -621,7 +621,7 @@ (if (> (month-days) (tm:mday now)) (set-tm:mday now month-days)) (set-tm:isdst now -1) - (gnc:secs->timepair (car (mktime now)))))) + (gnc:date->timepair now)))) ;; There is no GNC:RELATIVE-DATES list like the one mentioned in ;; gnucash-design.info, is there? Here are the currently defined diff --git a/src/scm/report/price-scatter.scm b/src/scm/report/price-scatter.scm index 5c07f76288..0ff090182a 100644 --- a/src/scm/report/price-scatter.scm +++ b/src/scm/report/price-scatter.scm @@ -30,7 +30,9 @@ (optname-stepsize (N_ "Step Size")) (optname-report-currency (N_ "Report's currency")) - (optname-accounts (N_ "Accounts")) + (optname-price-commodity (N_ "Price of Commodity")) + + ;; (optname-accounts (N_ "Accounts")) (optname-inc-exp (N_ "Show Income/Expense")) (optname-show-profit (N_ "Show Net Profit")) @@ -57,21 +59,29 @@ (gnc:options-add-interval-choice! options gnc:pagename-general optname-stepsize "b" 'MonthDelta) - (add-option - (gnc:make-account-list-option - gnc:pagename-accounts optname-accounts - "c" - (N_ "Report on these accounts, if chosen account level allows.") - (lambda () - (gnc:group-get-subaccounts (gnc:get-current-group))) - (lambda (accounts) - (list #t - accounts)) - #t)) +; (add-option +; (gnc:make-account-list-option +; gnc:pagename-accounts optname-accounts +; "c" +; (N_ "Report on these accounts, if chosen account level allows.") +; (lambda () +; (gnc:group-get-subaccounts (gnc:get-current-group))) +; (lambda (accounts) +; (list #t +; accounts)) +; #t)) (gnc:options-add-currency! options gnc:pagename-general optname-report-currency "d") + (add-option + (gnc:make-currency-option + gnc:pagename-general optname-price-commodity + "e" + (N_ "Calculate the price of this commodity.") + (gnc:locale-default-currency))) + + (gnc:options-add-plot-size! options gnc:pagename-display optname-plot-width optname-plot-height "c" 500 400) @@ -111,6 +121,12 @@ (gnc:option-value (gnc:lookup-option (gnc:report-options report-obj) section name))) + ;; small helper for the warnings below + (define (commodity-numeric->string c n) + (gnc:monetary->string + (gnc:make-gnc-monetary c n))) + + (let* ((to-date-tp (gnc:timepair-end-day-time (gnc:date-option-absolute-time (op-value gnc:pagename-general @@ -120,7 +136,7 @@ (op-value gnc:pagename-general optname-from-date)))) (interval (op-value gnc:pagename-general optname-stepsize)) - (accounts (op-value gnc:pagename-accounts optname-accounts)) +; (accounts (op-value gnc:pagename-accounts optname-accounts)) (height (op-value gnc:pagename-display optname-plot-height)) (width (op-value gnc:pagename-display optname-plot-width)) @@ -132,6 +148,8 @@ (report-currency (op-value gnc:pagename-general optname-report-currency)) + (price-commodity (op-value gnc:pagename-general + optname-price-commodity)) (dates-list (gnc:make-date-list (gnc:timepair-end-day-time from-date-tp) @@ -139,7 +157,12 @@ (eval interval))) (document (gnc:make-html-document)) - (chart (gnc:make-html-scatter))) + (chart (gnc:make-html-scatter)) + (currency-accounts + (filter gnc:account-has-shares? (gnc:group-get-subaccounts + (gnc:get-current-group)))) + (data '((1.0 1.0) (1.1 1.2) (1.2 1.4) (1.3 1.6) + (2.0 1.0) (2.1 1.2) (2.2 1.4) (2.3 1.6)))) (gnc:html-scatter-set-title! chart (_ "Price Plot (Test)")) @@ -155,13 +178,129 @@ ;;(gnc:html-scatter-set-markercolor! chart mcolor) (gnc:html-scatter-set-y-axis-label! chart (gnc:commodity-get-mnemonic report-currency)) + (gnc:html-scatter-set-x-axis-label! + chart (case interval + ('DayDelta (N_ "Days")) + ('WeekDelta (N_ "Weeks")) + ('TwoWeekDelta (N_ "Double-Weeks")) + ('MonthDelta (N_ "Months")) + ('YearDelta (N_ "Years")))) + (if + (not (gnc:commodity-equiv? report-currency price-commodity)) + (begin + (if (not (null? currency-accounts)) + ;; This is an experiment, and if the code is good, it could + ;; go into commodity-utilities.scm or even start a new file. + (set! + data + ;; go through all splits; convert all splits into a + ;; price. + (map + (lambda (a) + (let* ((transaction-comm (gnc:transaction-get-commodity + (gnc:split-get-parent a))) + (account-comm (gnc:account-get-commodity + (gnc:split-get-account a))) + (share-amount (gnc:split-get-share-amount a)) + (value-amount (gnc:split-get-value a)) + (transaction-date (gnc:transaction-get-date-posted + (gnc:split-get-parent a))) + (foreignlist + (if (gnc:commodity-equiv? transaction-comm + price-commodity) + (list account-comm + (gnc:numeric-neg share-amount) + (gnc:numeric-neg value-amount)) + (list transaction-comm + value-amount + share-amount)))) + +; (warn "render-scatterplot: value " +; (commodity-numeric->string +; (first foreignlist) (second foreignlist)) +; " bought shares " +; (commodity-numeric->string +; price-commodity (third foreignlist))) + + (list + transaction-date + (if (not (gnc:commodity-equiv? (first foreignlist) + report-currency)) + (begin + (warn "render-scatterplot: " + "Sorry, currency exchange not yet implemented:" + (commodity-numeric->string + (first foreignlist) (second foreignlist)) + " (buying " + (commodity-numeric->string + price-commodity (third foreignlist)) + ") =? " + (commodity-numeric->string + report-currency (gnc:numeric-zero))) + (gnc:numeric-zero)) + (gnc:numeric-div + (second foreignlist) + (third foreignlist) + GNC-DENOM-AUTO + (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))) + ;; Get all the interesting splits + (gnc:get-match-commodity-splits + currency-accounts + to-date-tp price-commodity)))) + + (set! data (filter + (lambda (x) (gnc:timepair-lt from-date-tp (first x))) + data)) + + ;; some output +; (warn (map (lambda (x) (list +; (gnc:timepair-to-datestring (car x)) +; (gnc:numeric-to-double (second x)))) +; data)) + + ;; convert the gnc:numeric's to doubles + (set! data (map (lambda (x) + (list (first x) + (gnc:numeric-to-double (second x)))) + data)) + + ;; convert the dates to the weird x-axis scaling of the + ;; scatterplot + (set! data + (map (lambda (x) + (list + (/ (- (car (first x)) + (car from-date-tp)) + ;; FIXME: These hard-coded values are more + ;; or less totally bogus. OTOH this whole + ;; scaling thing is totally bogus as well, + ;; so this doesn't matter too much. + (case interval + ('DayDelta 86400) + ('WeekDelta 604800) + ('TwoWeekDelta 1209600) + ('MonthDelta 2628000) + ('YearDelta 31536000))) + (second x))) + data)) + )) + (gnc:html-scatter-set-data! - chart - '((1.0 1.0) (1.1 1.2) (1.2 1.4) (1.3 1.6) - (2.0 1.0) (2.1 1.2) (2.2 1.4) (2.3 1.6))) + chart data) (gnc:html-document-add-object! document chart) + + (gnc:html-document-add-object! + document + (gnc:make-html-text + (gnc:html-markup-p + "This report calculates the 'prices of commodity' transactions \ +versus the 'report commodity'. (I.e. it won't work if there's another \ +commodity involved in between.) The prices shown are the actual values, \ +i.e. there is no averaging at all. This scaling of the x-axis looks so \ +weird that \ +we should rather throw it out before 1.6 is released, I guess (cstim)."))) document))