Skip to content

Commit

Permalink
[new-aging] speed up split->owner
Browse files Browse the repository at this point in the history 
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
  • Loading branch information
@christopherlam
christopherlam committed May 23, 2020
1 parent f2a13ec commit d8aecf9
Showing 1 changed file with 26 additions and 31 deletions.
57 changes: 26 additions & 31 deletions gnucash/report/reports/standard/new-aging.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand All @@ -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))
Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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 . _)
Expand All @@ -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)))))))))))))
Expand Down

1 comment on commit d8aecf9

@christopherlam
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Forgot to add some benchmarks. A conventional book with dozens of vendors.

statprof before this change:

%     cumulative   self             
time   seconds     seconds  procedure
 18.57      0.23      0.23  xaccPrintAmount
 18.57      0.23      0.23  gncOwnerGetOwnerFromLot
  8.57      0.11      0.11  gncOwnerReturnGUID
  7.14      0.09      0.09  qof-print-date
  5.71      0.07      0.07  display
  4.29      0.05      0.05  make-string
  4.29      0.05      0.05  open-output-string
  4.29      0.05      0.05  %after-gc-thunk
  4.29      0.05      0.05  gnc-scm-log-msg
  2.86      0.05      0.04  ice-9/boot-9.scm:769:2:throw
  2.86      0.04      0.04  gncOwnerNew
  2.86      0.04      0.04  gnc-commodity-print-info
  1.43      0.55      0.02  ice-9/boot-9.scm:781:2:catch
  1.43      0.12      0.02  ice-9/format.scm:139:4:format:format-work
  1.43      0.02      0.02  string-join
  1.43      0.02      0.02  xaccTransGetTxnType
  1.43      0.02      0.02  ice-9/format.scm:1609:9
  1.43      0.02      0.02  gnc-mktime
  1.43      0.02      0.02  xaccQueryGetSplitsUniqueTrans
  1.43      0.02      0.02  gncInvoiceGetTypeString
  1.43      0.02      0.02  list?
  1.43      0.02      0.02  write-char
  1.43      0.02      0.02  string=?
  0.00      1.24      0.00  standard/new-aging.scm:207:0:aging-renderer
  0.00      0.81      0.00  report-utilities.scm:894:0:gnc:owner-splits->aging-list
  0.00      0.55      0.00  report-utilities.scm:961:0:gnc:strify
  0.00      0.39      0.00  srfi/srfi-1.scm:590:5:map1
  0.00      0.39      0.00  partition
  0.00      0.39      0.00  standard/new-aging.scm:176:0:split-has-owner?
  0.00      0.39      0.00  standard/new-aging.scm:191:0:list-split
  0.00      0.28      0.00  report-utilities.scm:1032:6
  0.00      0.26      0.00  standard/new-aging.scm:197:0:split->owner
  0.00      0.25      0.00  ice-9/format.scm:39:0:format
  0.00      0.18      0.00  utilities.scm:63:0:gnc:msg
  0.00      0.16      0.00  utilities.scm:54:0:strify
  0.00      0.12      0.00  report-utilities.scm:1032:6
  0.00      0.11      0.00  standard/new-aging.scm:173:0:gnc-owner-equal?
  0.00      0.09      0.00  ice-9/format.scm:800:4:format:out-obj-padded
  0.00      0.05      0.00  anon #x7f5bdc2bf440
  0.00      0.05      0.00  ice-9/ports.scm:545:0:call-with-output-string
  0.00      0.04      0.00  report-utilities.scm:43:0:gnc:monetary->string
  0.00      0.02      0.00  report-utilities.scm:1032:6
  0.00      0.02      0.00  srfi/srfi-1.scm:634:2:for-each
  0.00      0.02      0.00  report-utilities.scm:887:0:make-extended-interval-list
  0.00      0.02      0.00  report-utilities.scm:1032:6
  0.00      0.02      0.00  gnc-budget-get-name
  0.00      0.02      0.00  xaccTransGetDate
  0.00      0.02      0.00  procedure-name
---
Sample count: 70
Total time: 1.235449805 seconds (0.272171376 seconds in GC)

statprof after this change:

%     cumulative   self             
time   seconds     seconds  procedure
 22.64      0.21      0.21  xaccPrintAmount
  9.43      0.09      0.09  %after-gc-thunk
  7.55      0.07      0.07  qof-print-date
  7.55      0.07      0.07  gnc-commodity-print-info
  5.66      0.16      0.05  ice-9/format.scm:139:4:format:format-work
  5.66      0.09      0.05  open-output-string
  5.66      0.05      0.05  gncSplitGetGUID
  3.77      0.63      0.03  ice-9/boot-9.scm:781:2:catch
  3.77      0.07      0.03  ice-9/boot-9.scm:769:2:throw
  3.77      0.03      0.03  string-hash
  3.77      0.03      0.03  gncInvoiceGetTypeString
  3.77      0.03      0.03  gncInvoiceGetTotal
  1.89      0.03      0.02  string-join
  1.89      0.02      0.02  gnc-scm-log-msg
  1.89      0.02      0.02  char=?
  1.89      0.02      0.02  memq
  1.89      0.02      0.02  gnc-localtime
  1.89      0.02      0.02  xaccQueryGetSplitsUniqueTrans
  1.89      0.02      0.02  gncOwnerGetOwnerFromLot
  1.89      0.02      0.02  display
  1.89      0.02      0.02  srfi/srfi-1.scm:835:0:any1
  0.00      0.92      0.00  standard/new-aging.scm:208:0:aging-renderer
  0.00      0.78      0.00  report-utilities.scm:894:0:gnc:owner-splits->aging-list
  0.00      0.63      0.00  report-utilities.scm:961:0:gnc:strify
  0.00      0.33      0.00  report-utilities.scm:1032:6
  0.00      0.30      0.00  srfi/srfi-1.scm:590:5:map1
  0.00      0.19      0.00  ice-9/format.scm:39:0:format
  0.00      0.12      0.00  utilities.scm:63:0:gnc:msg
  0.00      0.10      0.00  standard/new-aging.scm:191:4
  0.00      0.10      0.00  standard/new-aging.scm:182:0:list-split
  0.00      0.10      0.00  partition
  0.00      0.10      0.00  standard/new-aging.scm:173:0:split-has-owner?
  0.00      0.09      0.00  anon #x7f1261f33440
  0.00      0.09      0.00  utilities.scm:54:0:strify
  0.00      0.09      0.00  report-utilities.scm:1032:6
  0.00      0.07      0.00  report-utilities.scm:43:0:gnc:monetary->string
  0.00      0.07      0.00  ice-9/ports.scm:545:0:call-with-output-string
  0.00      0.07      0.00  ice-9/format.scm:800:4:format:out-obj-padded
  0.00      0.03      0.00  srfi/srfi-1.scm:634:2:for-each
  0.00      0.03      0.00  report-utilities.scm:1032:6
  0.00      0.03      0.00  procedure-name
  0.00      0.02      0.00  report-utilities.scm:1032:6
  0.00      0.02      0.00  standard/new-aging.scm:306:22
  0.00      0.02      0.00  srfi/srfi-1.scm:493:0:fold-right
  0.00      0.02      0.00  date-utilities.scm:192:0:moddate
  0.00      0.02      0.00  xaccAccountGetName
  0.00      0.02      0.00  standard/new-aging.scm:290:17
  0.00      0.02      0.00  report-utilities.scm:887:0:make-extended-interval-list
  0.00      0.02      0.00  report-utilities.scm:1032:6
  0.00      0.02      0.00  xaccTransGetDate
---
Sample count: 53
Total time: 0.921665886 seconds (0.181688892 seconds in GC)

Please sign in to comment.