From 91f3e9fefec44e392adf3968d9cdc7117b7d8913 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 5 Apr 2019 21:01:33 +0800 Subject: [PATCH] [commodity-utils] refactor totalavg price calculator use exact rationals, therefore test suite amended --- .../report-system/commodity-utilities.scm | 136 ++++++++---------- .../test/test-commodity-utils.scm | 22 ++- 2 files changed, 67 insertions(+), 91 deletions(-) diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm index 9726727170..4938ef0c7e 100644 --- a/gnucash/report/report-system/commodity-utilities.scm +++ b/gnucash/report/report-system/commodity-utilities.scm @@ -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 - (warn "gnc:get-commodity-totalavg-prices: " - "Sorry, currency exchange not yet implemented:" - (gnc:monetary->string - (gnc:make-gnc-monetary - (car foreignlist) (cadr foreignlist))) - " (buying " - (gnc:monetary->string - (gnc:make-gnc-monetary - price-commodity (caddr foreignlist))) - ") =? " - (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-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 txn-comm value-amt)) + " (buying " + (gnc:monetary->string + (gnc:make-gnc-monetary price-commodity share-amt)) + ") =? " + (gnc:monetary->string + (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', diff --git a/gnucash/report/report-system/test/test-commodity-utils.scm b/gnucash/report/report-system/test/test-commodity-utils.scm index 3a17d62abe..7a1e1cac14 100644 --- a/gnucash/report/report-system/test/test-commodity-utils.scm +++ b/gnucash/report/report-system/test/test-commodity-utils.scm @@ -566,26 +566,22 @@ (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)) - (cadr (assoc (gnc-dmy2time64-neutral 5 12 2014) - report-list))) + (/ 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)) - (cadr (assoc (gnc-dmy2time64-neutral 2 4 2015) report-list))) + (/ 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)) - (cadr (assoc (gnc-dmy2time64-neutral 11 3 2016) - report-list)))) + (/ 14637000/100 3700) + (cadr (assoc (gnc-dmy2time64-neutral 11 3 2016) + report-list)))) (test-end "Microsoft-USD") (test-begin "Daimler-DEM")