From 9d25b25be30b8ac15b5423e5e02f913142d1a7e9 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 19 Sep 2018 11:34:07 +0800 Subject: [PATCH 01/10] [report-utilities] add (gnc:strify) and (gnc:pk) for debugging The (gnc:strify) function will take an object, and try various methods to display a useful output. Instead of a cryptic "# () # ?" message it can show "Split" The (gnc:pk) function is a debugging tool. It will dump all arguments via gnc:strify to console and return the last argument. In addition, it will print the time stamp since the procedure was defined, and the delta time since the last (gnc:pk) call. (gnc:pk "call weird-fn with " acc " = " (weird-fn acc)) (gnc:pk "call another-fn =" (another-fn)) [d2.3243 t2.3243] call weird-fn with Acc = Mon<$25.00> [d0.1000 t2.4243] call another-fn = #t This would suggest that (weird-fn acc) ran for 0.1 seconds, and returned a gnc:gnc-monetary object. --- .../report/report-system/report-system.scm | 2 + .../report/report-system/report-utilities.scm | 87 +++++++++++++++++++ 2 files changed, 89 insertions(+) diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm index 73357a646d..f600835cf1 100644 --- a/gnucash/report/report-system/report-system.scm +++ b/gnucash/report/report-system/report-system.scm @@ -737,6 +737,8 @@ (export gnc:select-assoc-account-balance) (export gnc:get-assoc-account-balances-total) (export make-file-url) +(export gnc:strify) +(export gnc:pk) (load-from-path "commodity-utilities") (load-from-path "html-barchart") diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm index 1b8cde8f04..f01a97a4d5 100644 --- a/gnucash/report/report-system/report-utilities.scm +++ b/gnucash/report/report-system/report-utilities.scm @@ -18,6 +18,7 @@ ;; Boston, MA 02110-1301, USA gnu@gnu.org (use-modules (srfi srfi-13)) +(use-modules (ice-9 format)) (define (list-ref-safe list elt) (and (> (length list) elt) @@ -966,3 +967,89 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.") (if (string-prefix? "file:///" url) url (string-append "file:///" url))) + +(define-public (gnc:strify d) + ;; any object -> string. The option is passed to various + ;; scm->string converters; ultimately a generic stringify + ;; function handles symbol/string/other types. + (define (split->str spl) + (let ((txn (xaccSplitGetParent spl))) + (format #f "Split" + (qof-print-date (xaccTransGetDate txn)) + (xaccAccountGetName (xaccSplitGetAccount spl)) + (gnc:monetary->string + (gnc:make-gnc-monetary + (xaccTransGetCurrency txn) + (xaccSplitGetValue spl))) + (gnc:monetary->string + (gnc:make-gnc-monetary + (xaccAccountGetCommodity + (xaccSplitGetAccount spl)) + (xaccSplitGetAmount spl)))))) + (define (trans->str txn) + (format #f "Txn" (qof-print-date (xaccTransGetDate txn)))) + (define (account->str acc) + (format #f "Acc<~a>" (xaccAccountGetName acc))) + (define (monetary-collector->str coll) + (format #f "Mon-coll<~a>" + (map gnc:strify (coll 'format gnc:make-gnc-monetary #f)))) + (define (value-collector->str coll) + (format #f "Val-coll<~a>" + (map gnc:strify (coll 'total gnc:make-gnc-monetary)))) + (define (procedure->str proc) + (format #f "Proc<~a>" + (or (procedure-name proc) "unk"))) + (define (monetary->string mon) + (format #f "Mon<~a>" + (gnc:monetary->string mon))) + (define (try proc) + ;; Try proc with d as a parameter, catching 'wrong-type-arg + ;; exceptions to return #f to the (or) evaluator below. + (catch 'wrong-type-arg + (lambda () (proc d)) + (const #f))) + (or (and (boolean? d) (if d "#t" "#f")) + (and (null? d) "#null") + (and (symbol? d) (format #f "'~a" d)) + (and (string? d) d) + (and (list? d) (string-append + "(list " + (string-join (map gnc:strify d) " ") + ")")) + (and (pair? d) (format #f "(~a . ~a)" + (gnc:strify (car d)) + (if (eq? (car d) 'absolute) + (qof-print-date (cdr d)) + (gnc:strify (cdr d))))) + (try procedure->str) + (try gnc-commodity-get-mnemonic) + (try account->str) + (try split->str) + (try trans->str) + (try monetary-collector->str) + (try value-collector->str) + (try monetary->string) + (try gnc-budget-get-name) + (object->string d))) + +(define (pair->num pair) + (+ (car pair) + (/ (cdr pair) 1000000))) + +(define (delta t1 t2) + (exact->inexact + (- (pair->num t2) + (pair->num t1)))) + +(define-public gnc:pk + (let* ((start-time (gettimeofday)) + (last-time start-time)) + (lambda args + (let ((now (gettimeofday))) + (format #t "d~,4f t~,3f: " + (delta last-time now) + (delta start-time now)) + (set! last-time now)) + (display (map gnc:strify args)) + (newline) + (last args)))) From 4102e7007e0ac1f6cdc9bead7189c6caedcc3b30 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 26 Sep 2018 05:04:02 +0800 Subject: [PATCH 02/10] [test-report-utilities] gnc:strify tests --- .../test/test-report-utilities.scm | 28 +++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm index 531901b56c..f8d5241ba1 100644 --- a/gnucash/report/report-system/test/test-report-utilities.scm +++ b/gnucash/report/report-system/test/test-report-utilities.scm @@ -17,6 +17,7 @@ (test-account-get-trans-type-splits-interval) (test-list-ref-safe) (test-list-set-safe) + (test-gnc-pk) (test-gnc:monetary->string) (test-commodity-collector) (test-get-account-balances) @@ -103,6 +104,33 @@ (string? (gnc:monetary->string monetary)))) (teardown))) +(define (test-gnc-pk) + (test-begin "debugging tools") + (test-equal "gnc:pk testing" + 'works + (gnc:pk 'testing "gnc:pk" 'works)) + (test-equal "gnc:strify #t" + "#t" + (gnc:strify #t)) + (test-equal "gnc:strify '()" + "#null" + (gnc:strify '())) + (test-equal "gnc:strify 'sym" + "'sym" + (gnc:strify 'sym)) + (test-equal "gnc:strify \"str\"" + "str" + (gnc:strify "str")) + (test-equal "gnc:strify '(1 2 3)" + "(list 1 2 3)" + (gnc:strify '(1 2 3))) + (test-equal "gnc:strify (a . 2)" + "('a . 2)" + (gnc:strify (cons 'a 2))) + (test-equal "gnc:strify cons" + "Proc" + (gnc:strify cons))) + (define (test-commodity-collector) (test-group-with-cleanup "test-commodity-collector" (let* ((book (gnc-get-current-book)) From caa3807f05c48ffd124b1946537bf374204e6756 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 21 Sep 2018 10:36:43 +0800 Subject: [PATCH 03/10] Revert "Revert "[net-charts] deoptimize accounts-list"" This reverts commit 70bc472ffe93b80ad12db56e75332d09d3b0c1df. --- .../report/standard-reports/net-charts.scm | 56 ++++--------------- 1 file changed, 10 insertions(+), 46 deletions(-) diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm index 9e1e885a02..5a633e3fde 100644 --- a/gnucash/report/standard-reports/net-charts.scm +++ b/gnucash/report/standard-reports/net-charts.scm @@ -33,8 +33,6 @@ (use-modules (gnucash gnc-module)) (use-modules (gnucash gettext)) -(use-modules (gnucash report report-system report-collectors)) -(use-modules (gnucash report report-system collectors)) (use-modules (gnucash report standard-reports category-barchart)) ; for guids of called reports (gnc:module-load "gnucash/report/report-system" 0) @@ -306,50 +304,16 @@ (if (not (null? accounts)) - (let* ((the-account-destination-alist - (if inc-exp? - (append (map (lambda (account) (cons account 'asset)) - (assoc-ref classified-accounts ACCT-TYPE-INCOME)) - (map (lambda (account) (cons account 'liability)) - (assoc-ref classified-accounts ACCT-TYPE-EXPENSE))) - (append (map (lambda (account) (cons account 'asset)) - (assoc-ref classified-accounts ACCT-TYPE-ASSET)) - (map (lambda (account) (cons account 'liability)) - (assoc-ref classified-accounts ACCT-TYPE-LIABILITY))))) - (account-reformat (if inc-exp? - (lambda (account result) - (map (lambda (collector date-interval) - (gnc:monetary-neg (collector->monetary collector (second date-interval)))) - result dates-list)) - (lambda (account result) - (let ((commodity-collector (gnc:make-commodity-collector))) - (collector-end (fold (lambda (next date list-collector) - (commodity-collector 'merge next #f) - (collector-add list-collector - (collector->monetary - commodity-collector date))) - (collector-into-list) - result - dates-list)))))) - (work (category-by-account-report-work inc-exp? - dates-list - the-account-destination-alist - (lambda (account date) - (make-gnc-collector-collector)) - account-reformat)) - (rpt (category-by-account-report-do-work work (cons 50 90))) - (assets (assoc-ref rpt 'asset)) - (liabilities (assoc-ref rpt 'liability)) - (assets-list (if assets - (car assets) - (map (lambda (d) - (gnc:make-gnc-monetary report-currency 0)) - dates-list))) - (liability-list (if liabilities - (car liabilities) - (map (lambda (d) - (gnc:make-gnc-monetary report-currency 0)) - dates-list))) + (let* ((assets-list (process-datelist + (if inc-exp? + accounts + (assoc-ref classified-accounts ACCT-TYPE-ASSET)) + dates-list #t)) + (liability-list (process-datelist + (if inc-exp? + accounts + (assoc-ref classified-accounts ACCT-TYPE-LIABILITY)) + dates-list #f)) (net-list (map monetary+ assets-list liability-list)) ;; Here the date strings for the x-axis labels are ;; created. From 53cab269f467cf73ff7e20cde797cd08212b9435 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 19 Sep 2018 10:16:06 +0800 Subject: [PATCH 04/10] [test-charts] add basic test for net-charts amounts & dates This is similar to test-standard-net-linechart but designed to test date boundaries. Creates book with following entries in bank accounts, and calculates amounts at each date boundary. Bank1 Bank2 Bank3 05/05/69 $25 01/01/1970 05/01/70 $25 12/01/70 $10 18/01/70 $15 $50 01/02/1970 18/02/70 $50 01/03/1970 03/03/70 $200 01/04/1970 15/04/1970 --- .../standard-reports/test/test-charts.scm | 69 ++++++++++++++++++- 1 file changed, 68 insertions(+), 1 deletion(-) diff --git a/gnucash/report/standard-reports/test/test-charts.scm b/gnucash/report/standard-reports/test/test-charts.scm index 850b472279..b181cab38b 100644 --- a/gnucash/report/standard-reports/test/test-charts.scm +++ b/gnucash/report/standard-reports/test/test-charts.scm @@ -57,6 +57,9 @@ (define structure (list "Root" (list (cons 'type ACCT-TYPE-ASSET)) (list "Asset" + (list "Bank1") + (list "Bank2") + (list "Bank3") (list "Bank")) (list "Income" (list (cons 'type ACCT-TYPE-INCOME))) (list "Liability" (list (cons 'type ACCT-TYPE-LIABILITY))) @@ -75,6 +78,69 @@ (test-chart-variant variant) (gnc-clear-current-session))) +(define (test-net-chart-variant variant) + (define (set-option! options section name value) + (let ((option (gnc:lookup-option options section name))) + (if option + (gnc:option-set-value option value) + (test-assert (format #f "[~a] wrong-option ~a ~a" variant section name) #f)))) + (let* ((uuid (variant->uuid variant)) + (inc-exp? (memq variant '(income-expense-barchart income-expense-linechart))) + (env (create-test-env)) + (account-alist (env-create-account-structure-alist env structure)) + (bank1 (cdr (assoc "Bank1" account-alist))) + (bank2 (cdr (assoc "Bank2" account-alist))) + (bank3 (cdr (assoc "Bank3" account-alist))) + (liability (cdr (assoc "Liability" account-alist))) + (income (cdr (assoc "Income" account-alist))) + (expense (cdr (assoc "Expenses" account-alist))) + (equity (cdr (assoc "Equity" account-alist)))) + + (env-transfer env 12 01 1970 income bank1 10) + (env-transfer env 18 01 1970 income bank1 15) + (env-transfer env 03 03 1970 income bank1 200) + + (env-transfer env 18 01 1970 income bank2 50) + (env-transfer env 18 02 1970 income bank2 50) + + (env-transfer env 05 05 1969 income bank3 25) + (env-transfer env 05 01 1970 income bank3 25) + + ;; one closing txn which should be ignored by the inc-exp charts + (let ((txn (env-transfer env 03 01 1970 equity income 25))) + (xaccTransSetIsClosingTxn txn #t)) + + (let* ((options (gnc:make-report-options (variant->uuid variant)))) + (set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 1 1 1970))) + (set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 15 4 1970))) + (set-option! options "Accounts" "Accounts" (list income bank1 bank2 bank3)) + (set-option! options "General" "Step Size" 'MonthDelta) + (set-option! options "Display" "Show table" #t) + (format #t "\n\ntesting net-chart variant:~a\n" variant) + (let ((sxml (gnc:options->sxml uuid options (format #f "test-net-charts ~a 3 months" variant) + "test-table" #:strip-tag "script"))) + (unless inc-exp? + (test-equal "first row" + '("Date" "Assets" "Liabilities" "Net Worth") + (sxml->table-row-col sxml 1 0 #f)) + (test-equal "first data row" + '("01/01/70" "$25.00" "$0.00" "$25.00") + (sxml->table-row-col sxml 1 1 #f)) + (test-equal "last data row" + '("04/15/70" "$375.00" "$0.00" "$375.00") + (sxml->table-row-col sxml 1 -1 #f))) + + (when inc-exp? + (test-equal "first row" + '("Date" "Income" "Expense" "Net Profit") + (sxml->table-row-col sxml 1 0 #f)) + (test-equal "first data row" + '("01/01/70" "$100.00" "$0.00" "$100.00") + (sxml->table-row-col sxml 1 1 #f)) + (test-equal "last data row" + '("04/01/70" "$0.00" "$0.00" "$0.00") + (sxml->table-row-col sxml 1 -1 #f))))))) + (define (test-chart-variant variant) (define (set-option! options section name value) (let ((option (gnc:lookup-option options section name))) @@ -179,4 +245,5 @@ 'daily-tests) ((net-worth-barchart income-expense-barchart net-worth-linechart income-expense-linechart) - 'net-charts-tests)))) + (test-net-chart-variant variant))))) + From cacb15c3f3d1e9762d158df405151cf0d339a3eb Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 21 Sep 2018 02:38:05 +0800 Subject: [PATCH 05/10] [net-charts] create account->balancelist This function will scan the splitlist for account, and build a list of balances at the dates specified in the dates-list variable. --- .../report/standard-reports/net-charts.scm | 66 +++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm index 5a633e3fde..d099f9e89c 100644 --- a/gnucash/report/standard-reports/net-charts.scm +++ b/gnucash/report/standard-reports/net-charts.scm @@ -263,6 +263,72 @@ (define (monetary->double monetary) (gnc-numeric-to-double (gnc:gnc-monetary-amount monetary))) + (define (split->date s) + (xaccTransGetDate (xaccSplitGetParent s))) + + ;; this function will scan through the account splitlist, building + ;; a list of balances along the way. it will use the dates + ;; specified in the variable dates-list. + ;; input: account + ;; uses: dates-list (list of time64) + ;; out: (list account bal0 bal1 ...) + (define (account->balancelist account) + + ;; the test-closing? function will enable testing closing status + ;; for inc-exp only. this may squeeze more speed for net-worth charts. + (define test-closing? + (gnc:account-is-inc-exp? account)) + + (let loop ((splits (xaccAccountGetSplitList account)) + (dates dates-list) + (currentbal 0) + (lastbal 0) + (balancelist '())) + (cond + + ;; end of dates. job done! + ((null? dates) + (cons account (reverse balancelist))) + + ;; end of splits, but still has dates. pad with last-bal + ;; until end of dates. + ((null? splits) + (loop '() + (cdr dates) + currentbal + lastbal + (cons lastbal balancelist))) + + (else + (let* ((this (car splits)) + (rest (cdr splits)) + (currentbal (if (and test-closing? + (xaccTransGetIsClosingTxn (xaccSplitGetParent this))) + currentbal + (+ (xaccSplitGetAmount this) currentbal))) + (next (and (pair? rest) (car rest)))) + + (cond + ;; the next split is still before date + ((and next (< (split->date next) (car dates))) + (loop rest dates currentbal lastbal balancelist)) + + ;; this split after date, add previous bal to balancelist + ((< (car dates) (split->date this)) + (loop splits + (cdr dates) + lastbal + lastbal + (cons lastbal balancelist))) + + ;; this split before date, next split after date, or end. + (else + (loop rest + (cdr dates) + currentbal + currentbal + (cons currentbal balancelist))))))))) + ;; This calculates the balances for all the 'accounts' for each ;; element of the list 'dates'. If income?==#t, the signs get ;; reversed according to income-sign-reverse general option From ab97eed97989754637b9f90cfcbb40dd5366b883 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 21 Sep 2018 04:36:30 +0800 Subject: [PATCH 06/10] [net-charts] modify process-datelist to use account-balances This will retrieve the cached balances in account-balances, rather than calling (gnc:account-get-comm-balance-interval) or (gnc:account-get-comm-balance-at-date) which are very expensive because they will call xaccAccountGetBalanceAsOfDate which will scan the account splitlist every time. --- .../report/standard-reports/net-charts.scm | 86 +++++++++++-------- 1 file changed, 51 insertions(+), 35 deletions(-) diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm index d099f9e89c..8b28acf3e1 100644 --- a/gnucash/report/standard-reports/net-charts.scm +++ b/gnucash/report/standard-reports/net-charts.scm @@ -214,9 +214,7 @@ ;;(x-grid (if linechart? (get-option gnc:pagename-display optname-x-grid))) (commodity-list #f) (exchange-fn #f) - (dates-list ((if inc-exp? - gnc:make-date-interval-list - gnc:make-date-list) + (dates-list (gnc:make-date-list ((if inc-exp? gnc:time64-start-day-time gnc:time64-end-day-time) @@ -334,26 +332,47 @@ ;; reversed according to income-sign-reverse general option ;; settings. Uses the collector->monetary conversion function ;; above. Returns a list of gnc-monetary. - (define (process-datelist accounts dates income?) - (map - (lambda (date) - (collector->monetary - ((if inc-exp? - (if income? - gnc:accounts-get-comm-total-income - gnc:accounts-get-comm-total-expense) - gnc:accounts-get-comm-total-assets) - accounts - (lambda (account) - (if inc-exp? - ;; for inc-exp, 'date' is a pair of time values, else - ;; it is a time value. - (gnc:account-get-comm-balance-interval - account (first date) (second date) #f) - (gnc:account-get-comm-balance-at-date - account date #f)))) - (if inc-exp? (second date) date))) - dates)) + (define (process-datelist account-balances accounts dates income?) + + (define (get-nth-balance account n) + (let ((acct-balances (cdr (assoc account account-balances)))) + (list-ref acct-balances n))) + + (define (get-nth-interval account n) + (let ((bal1 (get-nth-balance account n)) + (bal2 (get-nth-balance account (1+ n)))) + (- bal2 bal1))) + + (define (monetary->collector mon) + (let ((c (gnc:make-commodity-collector))) + (c 'add (gnc:gnc-monetary-commodity mon) (gnc:gnc-monetary-amount mon)) + c)) + + (let loop ((dates dates) + (dates-idx 0) + (result '())) + (if (if inc-exp? + (null? (cdr dates)) + (null? dates)) + (reverse result) + (loop (cdr dates) + (1+ dates-idx) + (cons (collector->monetary + ((if inc-exp? + (if income? + gnc:accounts-get-comm-total-income + gnc:accounts-get-comm-total-expense) + gnc:accounts-get-comm-total-assets) + accounts + (lambda (account) + (monetary->collector + (gnc:make-gnc-monetary + (xaccAccountGetCommodity account) + (if inc-exp? + (get-nth-interval account dates-idx) + (get-nth-balance account dates-idx)))))) + (if inc-exp? (cadr dates) (car dates))) + result))))) (gnc:report-percent-done 1) (set! commodity-list (gnc:accounts-get-commodities @@ -370,36 +389,33 @@ (if (not (null? accounts)) - (let* ((assets-list (process-datelist + (let* ((account-balancelist (map account->balancelist accounts)) + (assets-list (process-datelist + account-balancelist (if inc-exp? accounts (assoc-ref classified-accounts ACCT-TYPE-ASSET)) dates-list #t)) (liability-list (process-datelist + account-balancelist (if inc-exp? accounts (assoc-ref classified-accounts ACCT-TYPE-LIABILITY)) dates-list #f)) (net-list (map monetary+ assets-list liability-list)) + (dates-list (if inc-exp? + (list-head dates-list (1- (length dates-list))) + dates-list)) ;; Here the date strings for the x-axis labels are ;; created. (datelist->stringlist (lambda (dates-list) (map (lambda (date-list-item) - (qof-print-date - (if inc-exp? - (car date-list-item) - date-list-item))) + (qof-print-date date-list-item)) dates-list))) (date-string-list (if linechart? (datelist->stringlist dates-list) - (map - (if inc-exp? - (lambda (date-list-item) - (qof-print-date - (car date-list-item))) - qof-print-date) - dates-list))) + (map qof-print-date dates-list))) (date-iso-string-list (let ((save-fmt (qof-date-format-get)) (retlist #f)) From a86d17e77df601f4453950801aa85065f8c2652b Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Tue, 25 Sep 2018 09:59:54 +0800 Subject: [PATCH 07/10] [net-charts] modify process-datelist to cycle balancelist once This will deconstruct process-datelist to not call the utility (gnc:accounts-get-comm-total-*) functions which are still slow, because they will cycle through the balancelist for each account. In a large enough report, the balance list may be thousands of entries long, and we don't want to cycle through them every time. This commit will loop all so that the balances are cycled once only. --- .../report/standard-reports/net-charts.scm | 93 +++++++++++-------- 1 file changed, 52 insertions(+), 41 deletions(-) diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm index 8b28acf3e1..b0d1c8ec5b 100644 --- a/gnucash/report/standard-reports/net-charts.scm +++ b/gnucash/report/standard-reports/net-charts.scm @@ -327,52 +327,69 @@ currentbal (cons currentbal balancelist))))))))) - ;; This calculates the balances for all the 'accounts' for each - ;; element of the list 'dates'. If income?==#t, the signs get - ;; reversed according to income-sign-reverse general option - ;; settings. Uses the collector->monetary conversion function - ;; above. Returns a list of gnc-monetary. - (define (process-datelist account-balances accounts dates income?) + ;; This calculates the balances for all the 'account-balances' for + ;; each element of the list 'dates'. Uses the collector->monetary + ;; conversion function above. Returns a list of gnc-monetary. + (define (process-datelist account-balances dates left-col?) - (define (get-nth-balance account n) - (let ((acct-balances (cdr (assoc account account-balances)))) - (list-ref acct-balances n))) + (define (collector-minus coll1 coll2) + (let ((res (gnc:make-commodity-collector))) + (res 'merge coll1 #f) + (res 'minusmerge coll2 #f) + res)) - (define (get-nth-interval account n) - (let ((bal1 (get-nth-balance account n)) - (bal2 (get-nth-balance account (1+ n)))) - (- bal2 bal1))) + (define accountlist + (if inc-exp? + (if left-col? + (assoc-ref classified-accounts ACCT-TYPE-INCOME) + (assoc-ref classified-accounts ACCT-TYPE-EXPENSE)) + (if left-col? + (assoc-ref classified-accounts ACCT-TYPE-ASSET) + (assoc-ref classified-accounts ACCT-TYPE-LIABILITY)))) - (define (monetary->collector mon) - (let ((c (gnc:make-commodity-collector))) - (c 'add (gnc:gnc-monetary-commodity mon) (gnc:gnc-monetary-amount mon)) - c)) + (define filtered-account-balances + (filter + (lambda (a) + (member (car a) accountlist)) + account-balances)) + + (define (acc-balances->list-of-balances lst) + ;; input: (list (list acc1 bal0 bal1 bal2 ...) + ;; (list acc2 bal0 bal1 bal2 ...) ...) + ;; whereby list of balances are numbers in the acc's currency + ;; output: (list ) + (define list-of-collectors + (let loop ((n (length dates)) (result '())) + (if (zero? n) result + (loop (1- n) (cons (gnc:make-commodity-collector) result))))) + (let loop ((lst lst)) + (when (pair? lst) + (let innerloop ((list-of-collectors list-of-collectors) + (list-of-balances (cdar lst))) + (when (pair? list-of-balances) + ((car list-of-collectors) 'add + (xaccAccountGetCommodity (caar lst)) + (car list-of-balances)) + (innerloop (cdr list-of-collectors) (cdr list-of-balances)))) + (loop (cdr lst)))) + list-of-collectors) (let loop ((dates dates) - (dates-idx 0) + (acct-balances (acc-balances->list-of-balances filtered-account-balances)) (result '())) (if (if inc-exp? (null? (cdr dates)) (null? dates)) (reverse result) (loop (cdr dates) - (1+ dates-idx) - (cons (collector->monetary - ((if inc-exp? - (if income? - gnc:accounts-get-comm-total-income - gnc:accounts-get-comm-total-expense) - gnc:accounts-get-comm-total-assets) - accounts - (lambda (account) - (monetary->collector - (gnc:make-gnc-monetary - (xaccAccountGetCommodity account) - (if inc-exp? - (get-nth-interval account dates-idx) - (get-nth-balance account dates-idx)))))) - (if inc-exp? (cadr dates) (car dates))) - result))))) + (cdr acct-balances) + (cons + (collector->monetary + (if inc-exp? + (collector-minus (car acct-balances) (cadr acct-balances)) + (car acct-balances)) + (if inc-exp? (cadr dates) (car dates))) + result))))) (gnc:report-percent-done 1) (set! commodity-list (gnc:accounts-get-commodities @@ -392,15 +409,9 @@ (let* ((account-balancelist (map account->balancelist accounts)) (assets-list (process-datelist account-balancelist - (if inc-exp? - accounts - (assoc-ref classified-accounts ACCT-TYPE-ASSET)) dates-list #t)) (liability-list (process-datelist account-balancelist - (if inc-exp? - accounts - (assoc-ref classified-accounts ACCT-TYPE-LIABILITY)) dates-list #f)) (net-list (map monetary+ assets-list liability-list)) (dates-list (if inc-exp? From 3f2a9022bf75b963be4ff3a5dc3f5c606db7bd96 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 23 Sep 2018 10:03:13 +0800 Subject: [PATCH 08/10] [net-charts] simplify date-list variables dates-list is now a list of time64 for both inc-exp and net-worth therefore we can combine the strings. --- .../report/standard-reports/net-charts.scm | 21 +++++++------------ 1 file changed, 7 insertions(+), 14 deletions(-) diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm index b0d1c8ec5b..18df1b96e4 100644 --- a/gnucash/report/standard-reports/net-charts.scm +++ b/gnucash/report/standard-reports/net-charts.scm @@ -413,27 +413,20 @@ (liability-list (process-datelist account-balancelist dates-list #f)) + (net-list (map monetary+ assets-list liability-list)) + (dates-list (if inc-exp? (list-head dates-list (1- (length dates-list))) dates-list)) - ;; Here the date strings for the x-axis labels are - ;; created. - (datelist->stringlist (lambda (dates-list) - (map (lambda (date-list-item) - (qof-print-date date-list-item)) - dates-list))) - (date-string-list (if linechart? - (datelist->stringlist dates-list) - (map qof-print-date dates-list))) + (date-string-list (map qof-print-date dates-list)) - (date-iso-string-list (let ((save-fmt (qof-date-format-get)) - (retlist #f)) + (date-iso-string-list (let ((save-fmt (qof-date-format-get))) (qof-date-format-set QOF-DATE-FORMAT-ISO) - (set! retlist (datelist->stringlist dates-list)) - (qof-date-format-set save-fmt) - retlist))) + (let ((retlist (map qof-print-date dates-list))) + (qof-date-format-set save-fmt) + retlist)))) (gnc:report-percent-done 90) From b1f03ecd9e1b65774263bf5440a1dcaf31c12cd7 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Tue, 2 Oct 2018 06:52:51 +0800 Subject: [PATCH 09/10] [net-charts] rename variables to mathematical terms This report seems to have evolved from a pure asset-liability chart. It handles income-expense too, so rename to minuend-subtrahend to be generic. Also report percentages done. --- .../report/standard-reports/net-charts.scm | 49 +++++++++---------- 1 file changed, 24 insertions(+), 25 deletions(-) diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm index 18df1b96e4..139a1ccc36 100644 --- a/gnucash/report/standard-reports/net-charts.scm +++ b/gnucash/report/standard-reports/net-charts.scm @@ -407,14 +407,19 @@ (if (not (null? accounts)) (let* ((account-balancelist (map account->balancelist accounts)) - (assets-list (process-datelist - account-balancelist - dates-list #t)) - (liability-list (process-datelist - account-balancelist - dates-list #f)) + (dummy (gnc:report-percent-done 60)) - (net-list (map monetary+ assets-list liability-list)) + (minuend-balances (process-datelist + account-balancelist + dates-list #t)) + (dummy (gnc:report-percent-done 70)) + + (subtrahend-balances (process-datelist + account-balancelist + dates-list #f)) + (dummy (gnc:report-percent-done 80)) + + (difference-balances (map monetary+ minuend-balances subtrahend-balances)) (dates-list (if inc-exp? (list-head dates-list (1- (length dates-list))) @@ -463,15 +468,12 @@ chart (gnc-commodity-get-mnemonic report-currency)) ;; Add the data - (if show-sep? - (begin - (add-column! (map monetary->double assets-list)) - (add-column! ;;(if inc-exp? - (map - (map monetary->double liability-list)) - ;;liability-list) - ))) + (when show-sep? + (add-column! (map monetary->double minuend-balances)) + (add-column! (map - (map monetary->double subtrahend-balances)))) + (if show-net? - (add-column! (map monetary->double net-list))) + (add-column! (map monetary->double difference-balances))) ;; Legend labels, colors ((if linechart? @@ -567,18 +569,15 @@ (if inc-exp? (list (_ "Net Profit")) (list (_ "Net Worth"))) - '())) - ) + '()))) (gnc:html-table-append-column! table date-string-list) - (if show-sep? - (begin - (gnc:html-table-append-column! table assets-list) - (gnc:html-table-append-column! table liability-list) - ) - ) + (when show-sep? + (gnc:html-table-append-column! table minuend-balances) + (gnc:html-table-append-column! table subtrahend-balances)) + (if show-net? - (gnc:html-table-append-column! table net-list) - ) + (gnc:html-table-append-column! table difference-balances)) + ;; set numeric columns to align right (for-each (lambda (col) From 23d2ed708e95334606b1dbb99592c402c93dbfb1 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Tue, 2 Oct 2018 07:27:27 +0800 Subject: [PATCH 10/10] [net-charts] remove doubles. send pure numbers to charts. --- gnucash/report/standard-reports/net-charts.scm | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm index 139a1ccc36..317a2200ba 100644 --- a/gnucash/report/standard-reports/net-charts.scm +++ b/gnucash/report/standard-reports/net-charts.scm @@ -258,9 +258,6 @@ (warn "incompatible currencies in monetary+: " a b))) (warn "wrong arguments for monetary+: " a b))) - (define (monetary->double monetary) - (gnc-numeric-to-double (gnc:gnc-monetary-amount monetary))) - (define (split->date s) (xaccTransGetDate (xaccSplitGetParent s))) @@ -469,11 +466,11 @@ ;; Add the data (when show-sep? - (add-column! (map monetary->double minuend-balances)) - (add-column! (map - (map monetary->double subtrahend-balances)))) + (add-column! (map gnc:gnc-monetary-amount minuend-balances)) + (add-column! (map - (map gnc:gnc-monetary-amount subtrahend-balances)))) (if show-net? - (add-column! (map monetary->double difference-balances))) + (add-column! (map gnc:gnc-monetary-amount difference-balances))) ;; Legend labels, colors ((if linechart?