IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

2001-05-05 Christian Stimming <stimming@tuhh.de>

Browse Source 
* 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.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@4118 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2001-05-05 19:28:33 +00:00
parent 4e3cc39316
commit 5964455515
4 changed files with 224 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
ChangeLog
View File

@ -1,3 +1,16 @@
2001-05-05 Christian Stimming <stimming@tuhh.de>
* 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 <dave@krondo.com>
* src/register/splitreg.c: set action cell to autosize

36
src/scm/commodity-utilities.scm
View File

@ -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:Split*>)))
(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

56
src/scm/date-utilities.scm
View File

@ -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

173
src/scm/report/price-scatter.scm
View File

@ -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))