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

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

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

@@ -566,26 +566,22 @@
(test-equal "MSFT totalavg 2012-01-15" (/ 4216500/100 1500) (test-equal "MSFT totalavg 2012-01-15" (/ 4216500/100 1500)
(cadr (assoc (gnc-dmy2time64-neutral 15 01 2012) (cadr (assoc (gnc-dmy2time64-neutral 15 01 2012)
report-list))) report-list)))
;; We have to use gnc-numeric-div with rounding in order to match the results ;; Astute observers will notice that the totals include the
;; from the function. 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 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 ;; 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 ;; the comment at the gnc:get-commodity-totalavg-prices definition for more
;; about the prices from this function. ;; about the prices from this function.
(test-equal "MSFT totalavg 2014-12-05" (test-equal "MSFT totalavg 2014-12-05"
(gnc-numeric-div 6637500/100 2000 GNC-DENOM-AUTO (/ 6637500/100 2000)
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)) (cadr (assoc (gnc-dmy2time64-neutral 5 12 2014)
(cadr (assoc (gnc-dmy2time64-neutral 5 12 2014) report-list)))
report-list)))
(test-equal "MSFT totalavg 2015-04-02" (test-equal "MSFT totalavg 2015-04-02"
(gnc-numeric-div 9860700/100 2800 GNC-DENOM-AUTO (/ 9860700/100 2800)
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)) (cadr (assoc (gnc-dmy2time64-neutral 2 4 2015) report-list)))
(cadr (assoc (gnc-dmy2time64-neutral 2 4 2015) report-list)))
(test-equal "MSFT totalavg 2016-03-11" (test-equal "MSFT totalavg 2016-03-11"
(gnc-numeric-div 14637000/100 3700 GNC-DENOM-AUTO (/ 14637000/100 3700)
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)) (cadr (assoc (gnc-dmy2time64-neutral 11 3 2016)
(cadr (assoc (gnc-dmy2time64-neutral 11 3 2016) report-list))))
report-list))))
(test-end "Microsoft-USD") (test-end "Microsoft-USD")
(test-begin "Daimler-DEM") (test-begin "Daimler-DEM")