gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Thu Nov 21 07:44:56 EST 2019


Updated	 via  https://github.com/Gnucash/gnucash/commit/063a2704 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/b3493509 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/dda3da84 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/f0a189ad (commit)
	from  https://github.com/Gnucash/gnucash/commit/26718142 (commit)



commit 063a2704995029cdc7f331e2d4d11c2cd8dbfdbf
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Nov 21 20:30:16 2019 +0800

    [new-owner-report] fix: payment->invoice gets invoice totals
    
    previously the payment-amount deduction loop used the
    payment-split-list to obtain the invoice-posting-split's amount. this
    would occasionally fail and would return the invoice-payment-split
    amount, obtaining the wrong sign.
    
    modify to retrieve the invoice total via gncInvoice API.
    
    therefore payment-amount, minus gncInvoiceGetTotal(inv) amounts,
    results in the overpayment amount.

diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index 10aaa60c8..5b40d0b7b 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -374,8 +374,7 @@
        (else
         (let* ((payment-split (car payment-splits))
                (inv (car payment-split))
-               (inv-split (cadr payment-split))
-               (inv-amount (AP-negate (xaccSplitGetAmount inv-split))))
+               (inv-amount (gncInvoiceGetTotal inv)))
           (lp (cdr payment-splits)
               (- amount inv-amount)
               (cons (list

commit b3493509d19f25de3498530e5409fd2559a9e6ff
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Nov 21 09:57:51 2019 +0800

    [balsheet-pnl] speed up by pre-generating account report-date splits
    
    previous code was very inefficient: if an account had N old splits and
    balance-sheet reported on M recent dates, it would scan splitlist
    multiple times: (1) to retrieve splits, (2) filter until
    column-date, (3) find the last one. i.e. total O(N * M * 3).
    
    this algorithm pre-generates the account's report-date splits by
    scanning each account only once, creating M splits which are queried
    by get-cell-anchor-fn via list-ref. i.e. O(N)
    
    it is immedialtely converted to a vector because we want O(1)
    access. from get-cell-anchor-fn
    
    a future optimisation may scan the accounts' splitlists once per
    report run, acquiring all required data (i.e. last period split,
    split->balance, closing entries) in 1 pass, to generate a column-data
    record.

diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm
index 0a6d618a7..2cf5d745a 100644
--- a/gnucash/report/standard-reports/balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/balsheet-pnl.scm
@@ -30,6 +30,7 @@
 (use-modules (gnucash gnc-module))
 (use-modules (gnucash gettext))
 (use-modules (srfi srfi-1))
+(use-modules (srfi srfi-2))
 
 (gnc:module-load "gnucash/report/report-system" 0)
 
@@ -901,19 +902,25 @@ also show overall period profit & loss."))
      ((eq? report-type 'balsheet)
       (let* ((get-cell-monetary-fn
               (lambda (account col-idx)
-                (let ((account-balance-list (assoc account accounts-balances)))
+                (let ((account-balance-list (assoc-ref accounts-balances account)))
                   (and account-balance-list
-                       (list-ref account-balance-list (1+ col-idx))))))
+                       (list-ref account-balance-list col-idx)))))
+
+             ;; an alist of account->last-split at date boundary
+             (accounts-splits-dates
+              (map
+               (lambda (acc)
+                 (cons acc (list->vector
+                            (gnc:account-accumulate-at-dates
+                             acc report-dates #:split->elt identity))))
+               accounts))
+
              (get-cell-anchor-fn
               (lambda (account col-idx)
-                (and (not (pair? account))
-                     (let* ((splits (xaccAccountGetSplitList account))
-                            (split-date (compose xaccTransGetDate xaccSplitGetParent))
-                            (date (list-ref report-dates col-idx))
-                            (valid-split? (lambda (s) (< (split-date s) date)))
-                            (valid-splits (filter valid-split? splits)))
-                       (and (pair? valid-splits)
-                            (gnc:split-anchor-text (last valid-splits)))))))
+                (and-let* (((not (pair? account)))
+                           (date-splits (assoc-ref accounts-splits-dates account))
+                           (split (vector-ref date-splits col-idx)))
+                  (gnc:split-anchor-text split))))
 
              (asset-liability-balances
               (let ((asset-liab-balances

commit dda3da841604c9a5b3aebcec8de5b0ca1b68a446
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Nov 21 12:20:57 2019 +0800

    [report-utilities][API] gnc:account-accumulate-at-dates
    
    this is a generalised form from gnc:account-get-balances-at-dates to
    accumulate a list from report dates.
    
    this function will scan through account splitlist, processing each
    split via split->elt, accumulating results at date boundaries into the
    results list. it uses ice-9 match for conciseness.
    
    in: acc   - account
        dates - a list of time64
        split->elt - an unary lambda. the result of calling (split->elt split)
                     will be accumulated onto the resulting list. by
                     default it returns the last split-balance before
                     date boundary, similar to gnc:account-get-balances-at-dates
    
    out: (list elt0 elt1 ...), each entry is the result of split->elt

diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 16726290d..4a80105f0 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -698,6 +698,7 @@
 (export gnc:commodity-collector-get-negated)
 (export gnc:commodity-collectorlist-get-merged) ;deprecated
 (export gnc-commodity-collector-commodity-count)
+(export gnc:account-accumulate-at-dates)
 (export gnc:account-get-balance-at-date)
 (export gnc:account-get-balances-at-dates)
 (export gnc:account-get-comm-balance-at-date)
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 36237a4b4..cd909c97e 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -19,6 +19,7 @@
 
 (use-modules (srfi srfi-13))
 (use-modules (ice-9 format))
+(use-modules (ice-9 match))
 
 (define (list-ref-safe list elt)
   (and (> (length list) elt)
@@ -468,53 +469,63 @@ flawed. see report-utilities.scm. please update reports.")
 (define* (gnc:account-get-balances-at-dates
           account dates-list #:key (split->amount xaccSplitGetAmount))
   (define (amount->monetary bal)
-    (gnc:make-gnc-monetary (xaccAccountGetCommodity account) bal))
-  (let loop ((splits (xaccAccountGetSplitList account))
-             (dates-list (sort dates-list <))
-             (currentbal 0)
-             (lastbal 0)
-             (balancelist '()))
-    (cond
-
-     ;; end of dates. job done!
-     ((null? dates-list)
-      (map amount->monetary (reverse balancelist)))
-
-     ;; end of splits, but still has dates. pad with last-bal
-     ;; until end of dates.
-     ((null? splits)
-      (loop '()
-            (cdr dates-list)
-            currentbal
-            lastbal
-            (cons lastbal balancelist)))
-
-     (else
-      (let* ((this (car splits))
-             (rest (cdr splits))
-             (currentbal (+ (or (split->amount this) 0) currentbal))
-             (next (and (pair? rest) (car rest))))
-
-        (cond
-         ;; the next split is still before date
-         ((and next (< (xaccTransGetDate (xaccSplitGetParent next)) (car dates-list)))
-          (loop rest dates-list currentbal lastbal balancelist))
-
-         ;; this split after date, add previous bal to balancelist
-         ((< (car dates-list) (xaccTransGetDate (xaccSplitGetParent this)))
-          (loop splits
-                (cdr dates-list)
-                lastbal
-                lastbal
-                (cons lastbal balancelist)))
-
-         ;; this split before date, next split after date, or end.
-         (else
-          (loop rest
-                (cdr dates-list)
-                currentbal
-                currentbal
-                (cons currentbal balancelist)))))))))
+    (gnc:make-gnc-monetary (xaccAccountGetCommodity account) (or bal 0)))
+  (define balance 0)
+  (map amount->monetary
+       (gnc:account-accumulate-at-dates
+        account dates-list #:split->elt
+        (lambda (s)
+          (if s (set! balance (+ balance (or (split->amount s) 0))))
+          balance))))
+
+
+;; this function will scan through account splitlist, building a list
+;; of split->elt results along the way at dates specified in dates.
+;; in: acc   - account
+;;     dates - a list of time64 -- it will be sorted
+;;     split->date - an unary lambda. result to compare with dates list.
+;;     split->elt - an unary lambda. it will be called successfully for each
+;;                  split in the account until the last date. the result
+;;                  will be accumulated onto the resulting list. the default
+;;                  xaccSplitGetBalance makes it similar to
+;;                  gnc:account-get-balances-at-dates.
+;; out: (list elt0 elt1 ...), each entry is the result of split->elt
+(define* (gnc:account-accumulate-at-dates
+          acc dates #:key
+          (split->date (compose xaccTransGetDate xaccSplitGetParent))
+          (split->elt xaccSplitGetBalance))
+  (let lp ((splits (xaccAccountGetSplitList acc))
+           (dates (sort dates <))
+           (result '())
+           (last-result #f))
+    (match dates
+
+      ;; end of dates. job done!
+      (() (reverse result))
+
+      ((date . rest)
+       (match splits
+
+         ;; end of splits, but still has dates. pad with last-result
+         ;; until end of dates.
+         (() (lp '() rest (cons last-result result) last-result))
+
+         ((head . tail)
+          (let ((next (and (pair? tail) (car tail))))
+            (cond
+
+             ;; the next split is still before date.
+             ((and next (< (split->date next) date))
+              (lp tail dates result (split->elt head)))
+
+             ;; head split after date, accumulate previous result
+             ((< date (split->date head))
+              (lp splits rest (cons last-result result) last-result))
+
+             ;; head split before date, next split after date, or end.
+             (else
+              (let ((head-result (split->elt head)))
+                (lp tail rest (cons head-result result) head-result)))))))))))
 
 ;; This works similar as above but returns a commodity-collector, 
 ;; thus takes care of children accounts with different currencies.
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index 7fd9eee5a..adf648a36 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -653,6 +653,11 @@
            (dates (gnc:make-date-list (gnc-dmy2time64 01 01 1970)
                                       (gnc-dmy2time64 01 04 1970)
                                       MonthDelta)))
+
+      (test-equal "empty account"
+        '(#f #f #f #f)
+        (gnc:account-accumulate-at-dates bank1 dates))
+
       (env-transfer env 15 01 1970 income bank1 10)
       (env-transfer env 15 02 1970 income bank1 10)
       (env-transfer env 15 03 1970 income bank1 10)
@@ -690,5 +695,21 @@
 
       (test-equal "1 txn in early slot"
         '(("USD" . 0) ("USD" . 10) ("USD" . 10) ("USD" . 10))
-        (map monetary->pair (gnc:account-get-balances-at-dates bank4 dates))))
+        (map monetary->pair (gnc:account-get-balances-at-dates bank4 dates)))
+
+      (test-equal "1 txn in each slot"
+        '(#f 10 20 40)
+        (gnc:account-accumulate-at-dates bank1 dates))
+
+      (test-equal "2 txn before start, 1 in middle"
+        '(20 20 30 30)
+        (gnc:account-accumulate-at-dates bank2 dates))
+
+      (test-equal "1 txn in late slot"
+        '(#f #f #f 10)
+        (gnc:account-accumulate-at-dates bank3 dates))
+
+      (test-equal "1 txn in early slot"
+        '(#f 10 10 10)
+        (gnc:account-accumulate-at-dates bank4 dates)))
     (teardown)))

commit f0a189adbbe5ab9e66c0a76f7fa82c9969bb1b6a
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Nov 21 11:51:05 2019 +0800

    [test-report-utilities] add test-get-account-at-dates

diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index 79728dade..7fd9eee5a 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -24,6 +24,7 @@
   (test-monetary-adders)
   (test-make-stats-collector)
   (test-utility-functions)
+  (test-get-account-at-dates)
   (test-end "report-utilities"))
 
 (define (NDayDelta t64 n)
@@ -625,3 +626,69 @@
       0
       (s 'numitems #f)))
   (test-end "gnc:make-stats-collector"))
+
+(define (monetary->pair mon)
+  (cons (gnc-commodity-get-mnemonic (gnc:gnc-monetary-commodity mon))
+        (gnc:gnc-monetary-amount mon)))
+
+(define (split->amount split)
+  (and split (xaccSplitGetAmount split)))
+
+(define (test-get-account-at-dates)
+  (test-group-with-cleanup "test-get-balance-at-dates"
+    (let* ((env (create-test-env))
+           (structure (list "Root" (list (cons 'type ACCT-TYPE-ASSET))
+                            (list "Asset"
+                                  (list "Bank1")
+                                  (list "Bank2")
+                                  (list "Bank3")
+                                  (list "Bank4"))
+                            (list "Income" (list (cons 'type ACCT-TYPE-INCOME)))))
+           (accounts (env-create-account-structure-alist env structure))
+           (bank1 (assoc-ref accounts "Bank1"))
+           (bank2 (assoc-ref accounts "Bank2"))
+           (bank3 (assoc-ref accounts "Bank3"))
+           (bank4 (assoc-ref accounts "Bank4"))
+           (income (assoc-ref accounts "Income"))
+           (dates (gnc:make-date-list (gnc-dmy2time64 01 01 1970)
+                                      (gnc-dmy2time64 01 04 1970)
+                                      MonthDelta)))
+      (env-transfer env 15 01 1970 income bank1 10)
+      (env-transfer env 15 02 1970 income bank1 10)
+      (env-transfer env 15 03 1970 income bank1 10)
+      (let ((clos (env-transfer env 18 03 1970 income bank1 10)))
+        (xaccTransSetIsClosingTxn clos #t))
+
+      (env-transfer env 15 12 1969 income bank2 10)
+      (env-transfer env 17 12 1969 income bank2 10)
+      (env-transfer env 15 02 1970 income bank2 10)
+
+      (env-transfer env 15 03 1970 income bank3 10)
+
+      (env-transfer env 15 01 1970 income bank4 10)
+
+      (test-equal "1 txn in each slot"
+        '(("USD" . 0) ("USD" . 10) ("USD" . 20) ("USD" . 40))
+        (map monetary->pair (gnc:account-get-balances-at-dates bank1 dates)))
+
+      (test-equal "1 txn in each slot, tests #:split->amount to ignore closing"
+        '(("USD" . 0) ("USD" . 10) ("USD" . 20) ("USD" . 30))
+        (map monetary->pair
+             (gnc:account-get-balances-at-dates
+              bank1 dates #:split->amount
+              (lambda (s)
+                (and (not (xaccTransGetIsClosingTxn (xaccSplitGetParent s)))
+                     (xaccSplitGetAmount s))))))
+
+      (test-equal "2 txn before start, 1 in middle"
+        '(("USD" . 20) ("USD" . 20) ("USD" . 30) ("USD" . 30))
+        (map monetary->pair (gnc:account-get-balances-at-dates bank2 dates)))
+
+      (test-equal "1 txn in late slot"
+        '(("USD" . 0) ("USD" . 0) ("USD" . 0) ("USD" . 10))
+        (map monetary->pair (gnc:account-get-balances-at-dates bank3 dates)))
+
+      (test-equal "1 txn in early slot"
+        '(("USD" . 0) ("USD" . 10) ("USD" . 10) ("USD" . 10))
+        (map monetary->pair (gnc:account-get-balances-at-dates bank4 dates))))
+    (teardown)))



Summary of changes:
 .../report/business-reports/new-owner-report.scm   |   3 +-
 gnucash/report/report-system/report-system.scm     |   1 +
 gnucash/report/report-system/report-utilities.scm  | 105 ++++++++++++---------
 .../report-system/test/test-report-utilities.scm   |  88 +++++++++++++++++
 gnucash/report/standard-reports/balsheet-pnl.scm   |  27 ++++--
 5 files changed, 165 insertions(+), 59 deletions(-)



More information about the gnucash-changes mailing list