[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.
This commit is contained in:
Christopher Lam 2018-09-25 09:59:54 +08:00
parent ab97eed979
commit a86d17e77d

View File

@ -327,52 +327,69 @@
currentbal currentbal
(cons currentbal balancelist))))))))) (cons currentbal balancelist)))))))))
;; This calculates the balances for all the 'accounts' for each ;; This calculates the balances for all the 'account-balances' for
;; element of the list 'dates'. If income?==#t, the signs get ;; each element of the list 'dates'. Uses the collector->monetary
;; reversed according to income-sign-reverse general option ;; conversion function above. Returns a list of gnc-monetary.
;; settings. Uses the collector->monetary conversion function (define (process-datelist account-balances dates left-col?)
;; above. Returns a list of gnc-monetary.
(define (process-datelist account-balances accounts dates income?)
(define (get-nth-balance account n) (define (collector-minus coll1 coll2)
(let ((acct-balances (cdr (assoc account account-balances)))) (let ((res (gnc:make-commodity-collector)))
(list-ref acct-balances n))) (res 'merge coll1 #f)
(res 'minusmerge coll2 #f)
res))
(define (get-nth-interval account n) (define accountlist
(let ((bal1 (get-nth-balance account n)) (if inc-exp?
(bal2 (get-nth-balance account (1+ n)))) (if left-col?
(- bal2 bal1))) (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) (define filtered-account-balances
(let ((c (gnc:make-commodity-collector))) (filter
(c 'add (gnc:gnc-monetary-commodity mon) (gnc:gnc-monetary-amount mon)) (lambda (a)
c)) (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 <mon-coll0> <mon-coll1> <mon-coll2>)
(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) (let loop ((dates dates)
(dates-idx 0) (acct-balances (acc-balances->list-of-balances filtered-account-balances))
(result '())) (result '()))
(if (if inc-exp? (if (if inc-exp?
(null? (cdr dates)) (null? (cdr dates))
(null? dates)) (null? dates))
(reverse result) (reverse result)
(loop (cdr dates) (loop (cdr dates)
(1+ dates-idx) (cdr acct-balances)
(cons (collector->monetary (cons
((if inc-exp? (collector->monetary
(if income? (if inc-exp?
gnc:accounts-get-comm-total-income (collector-minus (car acct-balances) (cadr acct-balances))
gnc:accounts-get-comm-total-expense) (car acct-balances))
gnc:accounts-get-comm-total-assets) (if inc-exp? (cadr dates) (car dates)))
accounts result)))))
(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) (gnc:report-percent-done 1)
(set! commodity-list (gnc:accounts-get-commodities (set! commodity-list (gnc:accounts-get-commodities
@ -392,15 +409,9 @@
(let* ((account-balancelist (map account->balancelist accounts)) (let* ((account-balancelist (map account->balancelist accounts))
(assets-list (process-datelist (assets-list (process-datelist
account-balancelist account-balancelist
(if inc-exp?
accounts
(assoc-ref classified-accounts ACCT-TYPE-ASSET))
dates-list #t)) dates-list #t))
(liability-list (process-datelist (liability-list (process-datelist
account-balancelist account-balancelist
(if inc-exp?
accounts
(assoc-ref classified-accounts ACCT-TYPE-LIABILITY))
dates-list #f)) dates-list #f))
(net-list (map monetary+ assets-list liability-list)) (net-list (map monetary+ assets-list liability-list))
(dates-list (if inc-exp? (dates-list (if inc-exp?