gnucash master: [new-aging] speed up split->owner

[Christopher Lam]

Updated	 via  https://github.com/Gnucash/gnucash/commit/d8aecf96 (commit)
	from  https://github.com/Gnucash/gnucash/commit/f2a13eca (commit)



commit d8aecf9695eb558277b967148b4eca26ca6a1f27
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat May 23 05:50:08 2020 +0800

    [new-aging] speed up split->owner
    
    several speed ups
    
    1. split->owner will now cache results, bypassing
    gncOwnerGetOwnerFromLot and gncInvoiceGetInvoiceFromLot for repeated
    calls to the same split.
    
    2. previously each call to split->owner would allocate a new
    gncOwner. now a new gncOwner is only allocated during a cache
    miss. the list of gncOwners is maintained and is purged when
    split->owner is called with #f. There is no need to maintain a tofree
    list of gncOwners anymore.
    
    3. instead of slow gncOwnerReturnGUID to test equality, use gncOwnerEqual

diff --git a/gnucash/report/reports/standard/new-aging.scm b/gnucash/report/reports/standard/new-aging.scm
index fe44c8330..f5a915692 100644
--- a/gnucash/report/reports/standard/new-aging.scm
+++ b/gnucash/report/reports/standard/new-aging.scm
@@ -170,20 +170,11 @@ exist but have no suitable transactions."))
     (not (or (eqv? type TXN-TYPE-INVOICE)
              (eqv? type TXN-TYPE-PAYMENT)))))
 
-(define (gnc-owner-equal? a b)
-  (string=? (gncOwnerReturnGUID a) (gncOwnerReturnGUID b)))
-
 (define (split-has-owner? split owner)
-  (let* ((split-owner (split->owner split))
-         (retval (gnc-owner-equal? split-owner owner)))
-    (gncOwnerFree split-owner)
-    retval))
+  (gncOwnerEqual (split->owner split) owner))
 
 (define (split-owner-is-invalid? split)
-  (let* ((owner (split->owner split))
-         (retval (not (gncOwnerIsValid owner))))
-    (gncOwnerFree owner)
-    retval))
+  (not (gncOwnerIsValid (split->owner split))))
 
 (define (split-from-acct? split acct)
   (equal? acct (xaccSplitGetAccount split)))
@@ -192,17 +183,27 @@ exist but have no suitable transactions."))
   (let-values (((list-yes list-no) (partition (lambda (elt) (fn elt cmp)) lst)))
     (cons list-yes list-no)))
 
-;; simpler version of gnc:owner-from-split. must be gncOwnerFree after
-;; use! see split-has-owner? above...
-(define (split->owner split)
-  (let* ((lot (xaccSplitGetLot split))
-         (owner (gncOwnerNew))
-         (use-lot-owner? (gncOwnerGetOwnerFromLot lot owner)))
-    (unless use-lot-owner?
-      (gncOwnerCopy (gncOwnerGetEndOwner
-                     (gncInvoiceGetOwner (gncInvoiceGetInvoiceFromLot lot)))
-                    owner))
-    owner))
+;; optimized from gnc:owner-from-split. It will allocate and memoize
+;; (cache) the owners because gncOwnerGetOwnerFromLot is slow. after
+;; use, it must be called with #f to free the owners.
+(define split->owner
+  (let ((ht (make-hash-table)))
+    (lambda (split)
+      (cond
+       ((not split)
+        (hash-for-each (lambda (k v) (gncOwnerFree v)) ht)
+        (hash-clear! ht))
+       ((hashv-ref ht (string-hash (gncSplitGetGUID split))) => identity)
+       (else
+        (let ((lot (xaccSplitGetLot split))
+              (owner (gncOwnerNew)))
+          (unless (gncOwnerGetOwnerFromLot lot owner)
+            (gncOwnerCopy (gncOwnerGetEndOwner
+                           (gncInvoiceGetOwner
+                            (gncInvoiceGetInvoiceFromLot lot)))
+                          owner))
+          (hashv-set! ht (string-hash (gncSplitGetGUID split)) owner)
+          owner))))))
 
 (define (aging-renderer report-obj receivable)
   (define options (gnc:report-options report-obj))
@@ -267,8 +268,7 @@ exist but have no suitable transactions."))
         (let loop ((accounts accounts)
                    (splits splits)
                    (accounts-and-owners '())
-                   (invalid-splits '())
-                   (tofree '()))
+                   (invalid-splits '()))
           (cond
            ((null? accounts)
 
@@ -345,7 +345,7 @@ exist but have no suitable transactions."))
                         acc-totals)))))
                  (reverse accounts-and-owners))
 
-                (for-each gncOwnerFree tofree)
+                (split->owner #f)       ;free the gncOwners
                 (gnc:html-document-add-object! document table)
 
                 (unless (null? invalid-splits)
@@ -371,7 +371,6 @@ exist but have no suitable transactions."))
               (let lp ((acc-splits (car splits-acc-others))
                        (acc-totals (make-list (1+ num-buckets) 0))
                        (invalid-splits invalid-splits)
-                       (tofree tofree)
                        (owners-and-aging '()))
 
                 (match acc-splits
@@ -382,8 +381,7 @@ exist but have no suitable transactions."))
                              accounts-and-owners
                              (cons (list account owners-and-aging acc-totals)
                                    accounts-and-owners))
-                         invalid-splits
-                         tofree))
+                         invalid-splits))
 
                   ;; txn type != TXN_TYPE_INVOICE or TXN_TYPE_PAYMENT.
                   (((? split-is-not-business? this) . rest)
@@ -392,7 +390,6 @@ exist but have no suitable transactions."))
                          acc-totals
                          (cons (list (format #f (_ "Invalid Txn Type ~a") type) this)
                                invalid-splits)
-                         tofree
                          owners-and-aging)))
 
                   ;; some payment splits may have no owner in this
@@ -402,7 +399,6 @@ exist but have no suitable transactions."))
                    (lp rest
                        acc-totals
                        (cons (list (_ "Payment has no owner") this) invalid-splits)
-                       tofree
                        owners-and-aging))
 
                   ((this . _)
@@ -416,7 +412,6 @@ exist but have no suitable transactions."))
                      (lp other-owner-splits
                          (map + acc-totals (reverse (cons aging-total aging)))
                          invalid-splits
-                         (cons owner tofree)
                          (if (or show-zeros (any (negate zero?) aging))
                              (cons (list owner aging aging-total) owners-and-aging)
                              owners-and-aging)))))))))))))



Summary of changes:
 gnucash/report/reports/standard/new-aging.scm | 57 ++++++++++++---------------
 1 file changed, 26 insertions(+), 31 deletions(-)