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-12 Christian Stimming <stimming@tuhh.de>

Browse Source 
* src/scm/report/price-scatter.scm: Extended option to use the
	pricedb as a price source.

	* src/scm/commodity-utilities.scm: Added functions for getting
	sorted commodity splits, for total-average-prices of a
	commodity-list, for instantaneous prices, for instantaneous prices
	of a commodity-list, and for cooking your morning coffee :)

	* src/scm/report-utilites.scm, html-utilities.scm: create new
	function (gnc:accounts-get-commodities), use it in
	html-utilities.scm.

	* src/scm/html-scatter.scm: add workaround for rgba color.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@4170 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Christian Stimming 2001-05-12 07:44:24 +00:00
parent 41b5acf7e4
commit df5b1cf465
6 changed files with 229 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
ChangeLog
View File

@ -1,3 +1,19 @@
2001-05-12 Christian Stimming <stimming@tuhh.de>
* src/scm/report/price-scatter.scm: Extended option to use the
pricedb as a price source.
* src/scm/commodity-utilities.scm: Added functions for getting
sorted commodity splits, for total-average-prices of a
commodity-list, for instantaneous prices, for instantaneous prices
of a commodity-list, and for cooking your morning coffee :)
* src/scm/report-utilites.scm, html-utilities.scm: create new
function (gnc:accounts-get-commodities), use it in
html-utilities.scm.
* src/scm/html-scatter.scm: add workaround for rgba color.
2001-05-12 Robert Graham Merkel <rgmerk@mira.net>
* src/scm/main-window.scm: create .gnucash if it doesn't exist

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

@ -76,6 +76,19 @@
(gnc:free-query query)
splits))
;; Returns a sorted list of all splits in the 'currency-accounts' up
;; to 'end-date-tp' which have the 'commodity' and one other commodity
;; involved. The splits are sorted by date.
(define (gnc:get-match-commodity-splits-sorted
currency-accounts end-date-tp commodity)
(sort (gnc:get-match-commodity-splits currency-accounts
end-date-tp commodity)
(lambda (a b)
(gnc:timepair-lt
(gnc:transaction-get-date-posted (gnc:split-get-parent a))
(gnc:transaction-get-date-posted (gnc:split-get-parent b))))))
;; 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
@ -86,9 +99,9 @@
;; Create a list of all prices of 'price-commodity' measured in the
;; currency 'report-currency'. The prices are taken from all splits in
;; 'currency-accounts' up until the date 'end-date-tp'. Returns a list
;; of lists. Each element-list looks like (time price), where 'time'
;; is the timepair when the 'price' was valid.
(define (gnc:get-commodity-totalaverage-prices
;; of lists. Each listelement looks like the list (time price), where
;; 'time' is the timepair when the <gnc:numeric*> 'price' was valid.
(define (gnc:get-commodity-totalavg-prices
currency-accounts end-date-tp price-commodity report-currency)
(let ((total-foreign (gnc:numeric-zero))
(total-domestic (gnc:numeric-zero)))
@ -112,19 +125,19 @@
(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)))
;; (warn "gnc:get-commodity-totalavg-prices: 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 "totalaverage-prices: "
(warn "gnc:get-commodity-totalavg-prices: "
"Sorry, currency exchange not yet implemented:"
(commodity-numeric->string
(first foreignlist) (second foreignlist))
@ -147,24 +160,106 @@
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))))
;; Get all the interesting splits, and sort them according to the
;; date.
(sort
(gnc:get-match-commodity-splits
currency-accounts
end-date-tp price-commodity)
(lambda (a b)
(gnc:timepair-lt
(gnc:transaction-get-date-posted
(gnc:split-get-parent a))
(gnc:transaction-get-date-posted
(gnc:split-get-parent b)))))
)))
(gnc:get-match-commodity-splits-sorted
currency-accounts
end-date-tp price-commodity))))
;; Go through all toplevel non-report-commodity balances in sumlist
;; and add them to report-commodity, if possible. This function takes
;; a sumlist (described below) and returns an alist similar to one
;; value of the sumlist's alist, e.g. (cadr (assoc report-commodity
;; sumlist))). This resulting alist can immediately be plugged into
;; gnc:make-exchange-alist.
;; Create a list of prices for all commodities in 'commodity-list',
;; i.e. the same thing as in get-commodity-totalavg-prices but
;; extended to a commodity-list. Returns an alist. Each pair consists
;; of the foreign-currency and the appropriate list from
;; gnc:get-commodity-totalavg-prices, see there.
(define (gnc:get-commoditylist-totalavg-prices
currency-accounts end-date-tp commodity-list report-currency)
(map
(lambda (c)
(cons c
(gnc:get-commodity-totalavg-prices
currency-accounts end-date-tp c report-currency)))
commodity-list))
;; Get the instantaneous prices for the 'price-commodity', measured in
;; amounts of the 'report-currency'. The prices are taken from all
;; splits in 'currency-accounts' up until the date
;; 'end-date-tp'. Returns a list of lists. Each listelement looks like
;; the list (time price), where 'time' is the timepair when the
;; <gnc:numeric*> 'price' was valid.
(define (gnc:get-commodity-inst-prices
currency-accounts end-date-tp price-commodity report-currency)
;; go through all splits; convert all splits into a price.
(map-in-order
(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:numeric-abs
(gnc:split-get-share-amount a)))
(value-amount (gnc:numeric-abs
(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
share-amount value-amount)
(list transaction-comm
value-amount share-amount))))
;;(warn "get-commodity-inst-prices: 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 "get-commodity-inst-prices: "
"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, sorted by date.
(gnc:get-match-commodity-splits-sorted
currency-accounts
end-date-tp price-commodity)))
;; Get the instantaneous prices for all commodities in
;; 'commodity-list', i.e. the same thing as get-commodity-inst-prices
;; but extended to a commodity-list. Returns an alist. Each pair
;; consists of the foreign-currency and the appropriate list from
;; gnc:get-commodity-inst-prices, see there.
(define (gnc:get-commoditylist-inst-prices
currency-accounts end-date-tp commodity-list report-currency)
(map
(lambda (c)
(cons c
(gnc:get-commodity-inst-prices
currency-accounts end-date-tp c report-currency)))
commodity-list))
;; Go through all toplevel non-'report-commodity' balances in
;; 'sumlist' and add them to 'report-commodity', if possible. This
;; function takes a sumlist (described in gnc:get-exchange-totals) and
;; returns an alist similar to one value of the sumlist's alist,
;; e.g. (cadr (assoc report-commodity sumlist))). This resulting alist
;; can immediately be plugged into gnc:make-exchange-alist.
(define (gnc:resolve-unknown-comm sumlist report-commodity)
;; reportlist contains all known transactions with the
;; report-commodity, and now the transactions with unknown

5
src/scm/html-scatter.scm
View File

@ -163,7 +163,10 @@
(y-label (gnc:html-scatter-y-axis-label scatter))
(data (gnc:html-scatter-data scatter))
(marker (gnc:html-scatter-marker scatter))
(markercolor (gnc:html-scatter-markercolor scatter)))
;; Workaround to set the alpha channel, since libguppitank
;; requires a rgba value here.
(markercolor (string-append (gnc:html-scatter-markercolor scatter)
"ff")))
(if (and (list? data)
(not (null? data)))
(begin

15
src/scm/html-utilities.scm
View File

@ -601,17 +601,14 @@
table))
;; Returns a html-object which is a table of all exchange rates.
;; Where the report's commodity is common-commodity.
;; Create a html-table of all exchange rates. The report-commodity is
;; 'common-commodity', the exchange rates are given through the
;; function 'exchange-fn' and the 'accounts' determine which
;; commodities to show. Returns a html-object, a <html-table>.
(define (gnc:html-make-exchangerates
common-commodity exchange-fn accounts)
(let ((comm-list (delete
common-commodity
(delete-duplicates
(sort (map gnc:account-get-commodity accounts)
(lambda (a b)
(string<? (gnc:commodity-get-mnemonic a)
(gnc:commodity-get-mnemonic b)))))))
(let ((comm-list
(gnc:accounts-get-commodities accounts common-commodity))
(table (gnc:make-html-table)))
(if (not (null? comm-list))

33
src/scm/report-utilities.scm
View File

@ -114,6 +114,17 @@
(cons 'credit-line (_ "Credit Lines")))
type))
;; Get the list of all different commodities that are used within the
;; 'accounts', excluding the 'exclude-commodity'.
(define (gnc:accounts-get-commodities accounts exclude-commodity)
(delete exclude-commodity
(delete-duplicates
(sort (map gnc:account-get-commodity accounts)
(lambda (a b)
(string<? (gnc:commodity-get-mnemonic a)
(gnc:commodity-get-mnemonic b)))))))
;; Returns the depth of the current account hierarchy, that is, the
;; maximum level of subaccounts in the current-group.
(define (gnc:get-current-group-depth)
@ -206,6 +217,28 @@
;;; It would be a logical extension to throw in a "slot" for x^2 so
;;; that you could also extract the variance and standard deviation
;; An IRC discussion on the performance of this: <cstim> rlb: I was
;; wondering which one would perform better: The directly stored
;; lambda in make-{stats,commodity}-collector, or just a value
;; somewhere with an exhaustive set of functions on it? <rlb> cstim:
;; my guess in the long run, a goops object would be most appropriate,
;; and barring that, a record with a suitable set of functions defined
;; to manipulate it would be faster, but in the short run (i.e. until
;; we switch to requiring goops), it might not be worth changing.
;; However, a record for the data (or vector) and a set of 7 functions
;; would still be faster, if for no other reason than because you
;; don't have to do the "case" lookup. That penalty can be avoided if
;; you follow the other strategy where passing in 'adder simply
;; returns the function, rather than calling it. Then the user's code
;; can cache the value when repeated lookups would be expensive. Also
;; everyone should note that in some tests Bill and I did here, plain
;; old alists were faster than hash tables until you got to a
;; reasonable size (i.e. greater than 10 elements, maybe greater than
;; 30...) <cstim> rlb: hm, that makes sense. However, any change
;; would break existing code, so if I would go for speed optimization
;; I might just go for the record-and-function-set way. <rlb> cstim:
;; yes. I think that would still be faster.
(define (gnc:make-stats-collector)
(let ;;; values
((value 0)

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

@ -28,8 +28,9 @@
(let ((optname-from-date (N_ "From"))
(optname-to-date (N_ "To"))
(optname-stepsize (N_ "Step Size"))
(optname-report-currency (N_ "Report's currency"))
(pagename-price (N_ "Price"))
(optname-report-currency (N_ "Report's currency"))
(optname-price-commodity (N_ "Price of Commodity"))
(optname-price-source (N_ "Price Source"))
@ -61,18 +62,18 @@
options gnc:pagename-general optname-stepsize "b" 'MonthDelta)
(gnc:options-add-currency!
options gnc:pagename-general optname-report-currency "d")
options pagename-price optname-report-currency "d")
(add-option
(gnc:make-currency-option
gnc:pagename-general optname-price-commodity
pagename-price optname-price-commodity
"e"
(N_ "Calculate the price of this commodity.")
(gnc:locale-default-currency)))
(add-option
(gnc:make-multichoice-option
gnc:pagename-general optname-price-source
pagename-price optname-price-source
"f" (N_ "The source of price information")
'actual-transactions
(list (vector 'weighted-average
@ -81,9 +82,9 @@
(vector 'actual-transactions
(N_ "Actual Transactions")
(N_ "The instantaneous price of actual currency transactions in the past"))
;;(vector 'pricedb-nearest
;; (N_ "Pricedb: Nearest in time")
;; (N_ "The price recorded nearest in time to the report date"))
(vector 'pricedb
(N_ "Price Database")
(N_ "The recorded prices"))
)))
@ -142,11 +143,11 @@
(gnc:lookup-option (gnc:report-options report-obj)
gnc:pagename-display optname-markercolor)))
(report-currency (op-value gnc:pagename-general
(report-currency (op-value pagename-price
optname-report-currency))
(price-commodity (op-value gnc:pagename-general
(price-commodity (op-value pagename-price
optname-price-commodity))
(price-source (op-value gnc:pagename-general
(price-source (op-value pagename-price
optname-price-source))
(dates-list (gnc:make-date-list
@ -166,10 +167,13 @@
(gnc:html-scatter-set-title!
chart report-title)
(gnc:html-scatter-set-subtitle!
chart (sprintf #f
(_ "%s to %s")
(gnc:timepair-to-datestring from-date-tp)
(gnc:timepair-to-datestring to-date-tp)))
chart (string-append
(gnc:commodity-get-mnemonic price-commodity)
" - "
(sprintf #f
(_ "%s to %s")
(gnc:timepair-to-datestring from-date-tp)
(gnc:timepair-to-datestring to-date-tp))))
(gnc:html-scatter-set-width! chart width)
(gnc:html-scatter-set-height! chart height)
(gnc:html-scatter-set-marker! chart
@ -180,9 +184,6 @@
('asterisk "asterisk")
('filledcircle "filled circle")
('filledsquare "filled square")))
;;(warn marker mcolor)
;; FIXME: workaround to set the alpha channel
(set! mcolor (string-append mcolor "ff"))
(gnc:html-scatter-set-markercolor! chart mcolor)
(gnc:html-scatter-set-y-axis-label!
chart (gnc:commodity-get-mnemonic report-currency))
@ -198,81 +199,37 @@
(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
(case price-source
('actual-transactions
;; 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)))
('weighted-average
(gnc:get-commodity-totalaverage-prices
(gnc:get-commodity-inst-prices
currency-accounts to-date-tp
price-commodity report-currency))
('weighted-average
(gnc:get-commodity-totalavg-prices
currency-accounts to-date-tp
price-commodity report-currency))
('pricedb
(map (lambda (p)
(list (gnc:price-get-time p)
(gnc:price-get-value p)))
(gnc:pricedb-get-prices
(gnc:book-get-pricedb (gnc:get-current-book))
price-commodity report-currency)))
)))
(set! data (filter
(lambda (x)
(gnc:timepair-lt from-date-tp (first x)))
(and
(gnc:timepair-ge to-date-tp (first x))
(gnc:timepair-ge (first x) from-date-tp)))
data))
;; some output
;;(warn (map (lambda (x) (list
;; (gnc:timepair-to-datestring (car x))
;; (gnc:numeric-to-double (second x))))
;;(warn "data" (map (lambda (x) (list
;; (gnc:timepair-to-datestring (car x))
;; (gnc:numeric-to-double (second x))))
;;data))
;; convert the gnc:numeric's to doubles
@ -307,20 +264,21 @@
(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.) cstim.")))
;; (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.) cstim.")))
document))
;; Here we define the actual report
(gnc:define-report
'version 1
'name (N_ "Price Scatter Plot (Test)")
;;'menu-path (list gnc:menuname-asset-liability)
'name (N_ "Price")
'menu-path (list gnc:menuname-asset-liability)
'menu-name (N_ "Price Scatterplot")
'options-generator options-generator
'renderer renderer))