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

[commodity-utils] refactor totalavg price calculator

Browse Source 
use exact rationals, therefore test suite amended
This commit is contained in:
Christopher Lam
2019-04-05 21:01:33 +08:00
parent 76936bc646
commit 91f3e9fefe
2 changed files with 67 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files

122
gnucash/report/report-system/commodity-utilities.scm
View File

@@ -121,86 +121,66 @@ construct with gnc:make-gnc-monetary and gnc:monetary->string instead.")
currency-accounts end-date price-commodity)))
(define (gnc:get-commodity-totalavg-prices-internal
currency-accounts end-date price-commodity report-currency
commodity-splits)
(let ((total-foreign 0)
(total-domestic 0))
(filter
gnc:price-is-not-zero?
(map-in-order
(lambda (a)
(let* ((transaction-comm (xaccTransGetCurrency
(xaccSplitGetParent a)))
(account-comm (xaccAccountGetCommodity
(xaccSplitGetAccount a)))
(share-amount (abs
(xaccSplitGetAmount a)))
(value-amount (abs
(xaccSplitGetValue a)))
(transaction-date (xaccTransGetDate
(xaccSplitGetParent a)))
(foreignlist
(if (and
(not (zero? share-amount))
(not (zero? value-amount)))
(if (gnc-commodity-equiv transaction-comm
price-commodity)
(list account-comm
share-amount value-amount)
(list transaction-comm
value-amount share-amount))
#f)))
currency-accounts end-date price-commodity report-currency commodity-splits)
(let loop ((tot-foreign 0)
(tot-domestic 0)
(commodity-splits commodity-splits)
(result '()))
(if (null? commodity-splits)
(reverse! result)
(let* ((a (car commodity-splits))
(share-amt (abs (xaccSplitGetAmount a)))
(value-amt (abs (xaccSplitGetValue a)))
(txn-comm (xaccTransGetCurrency (xaccSplitGetParent a)))
(acc-comm (xaccAccountGetCommodity (xaccSplitGetAccount a)))
(txn-date (xaccTransGetDate (xaccSplitGetParent a))))
(cond
((or (zero? share-amt) (zero? value-amt))
(loop tot-foreign
tot-domestic
(cdr commodity-splits)
result))
;; Try EURO exchange if necessary
(if (and foreignlist
(not (gnc-commodity-equiv (car foreignlist)
report-currency)))
(let ((exchanged (gnc:exchange-by-euro-numeric
(car foreignlist) (cadr foreignlist)
report-currency transaction-date)))
(if exchanged
(set! foreignlist
(list report-currency
(gnc:gnc-monetary-amount exchanged)
(caddr foreignlist))))))
((gnc-commodity-equiv acc-comm report-currency)
(let ((new-foreign (+ tot-foreign value-amt))
(new-domestic (+ tot-domestic share-amt)))
(loop new-foreign
new-domestic
(cdr commodity-splits)
(cons (list txn-date (/ new-domestic new-foreign)) result))))
(list
transaction-date
(if foreignlist
(if (not (gnc-commodity-equiv (car foreignlist)
report-currency))
(begin
((gnc-commodity-equiv txn-comm report-currency)
(let ((new-foreign (+ tot-foreign share-amt))
(new-domestic (+ tot-domestic value-amt)))
(loop new-foreign
new-domestic
(cdr commodity-splits)
(cons (list txn-date (/ new-domestic new-foreign)) result))))
((gnc:exchange-by-euro-numeric txn-comm value-amt report-currency txn-date)
=> (lambda (amt)
(let ((new-foreign (+ tot-foreign share-amt))
(new-domestic (+ tot-domestic (gnc:gnc-monetary-amount amt))))
(loop new-foreign
new-domestic
(cdr commodity-splits)
(cons (list txn-date (/ new-domestic new-foreign)) result)))))
(else
(warn "gnc:get-commodity-totalavg-prices: "
"Sorry, currency exchange not yet implemented:"
(gnc:monetary->string
(gnc:make-gnc-monetary
(car foreignlist) (cadr foreignlist)))
(gnc:make-gnc-monetary txn-comm value-amt))
" (buying "
(gnc:monetary->string
(gnc:make-gnc-monetary
price-commodity (caddr foreignlist)))
(gnc:make-gnc-monetary price-commodity share-amt))
") =? "
(gnc:monetary->string
(gnc:make-gnc-monetary
report-currency 0)))
0)
(begin
(set! total-foreign (gnc-numeric-add total-foreign
(caddr foreignlist)
GNC-DENOM-AUTO
GNC-DENOM-LCD))
(set! total-domestic (gnc-numeric-add total-domestic
(cadr foreignlist)
GNC-DENOM-AUTO
GNC-DENOM-LCD))
(if (not (zero? total-foreign))
(gnc-numeric-div
total-domestic
total-foreign
GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)) 0)))
#f))))
commodity-splits))))
(gnc:make-gnc-monetary report-currency 0)))
(loop tot-foreign
tot-domestic
(cdr commodity-splits)
result)))))))
;; Create a list of prices for all commodities in 'commodity-list',

12
gnucash/report/report-system/test/test-commodity-utils.scm
View File

@@ -566,24 +566,20 @@
(test-equal "MSFT totalavg 2012-01-15" (/ 4216500/100 1500)
(cadr (assoc (gnc-dmy2time64-neutral 15 01 2012)
report-list)))
;; We have to use gnc-numeric-div with rounding in order to match the results
;; from the function. Astute observers will notice that the totals include the
;; Astute observers will notice that the totals include the
;; capital gain split but not the acutal sell split on the day because the
;; capital gain price is first in the list so that's the one (assoc) finds. See
;; the comment at the gnc:get-commodity-totalavg-prices definition for more
;; about the prices from this function.
(test-equal "MSFT totalavg 2014-12-05"
(gnc-numeric-div 6637500/100 2000 GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))
(/ 6637500/100 2000)
(cadr (assoc (gnc-dmy2time64-neutral 5 12 2014)
report-list)))
(test-equal "MSFT totalavg 2015-04-02"
(gnc-numeric-div 9860700/100 2800 GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))
(/ 9860700/100 2800)
(cadr (assoc (gnc-dmy2time64-neutral 2 4 2015) report-list)))
(test-equal "MSFT totalavg 2016-03-11"
(gnc-numeric-div 14637000/100 3700 GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))
(/ 14637000/100 3700)
(cadr (assoc (gnc-dmy2time64-neutral 11 3 2016)
report-list))))
(test-end "Microsoft-USD")