[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.
This commit is contained in:
Christopher Lam 2018-09-21 04:36:30 +08:00
parent cacb15c3f3
commit ab97eed979

View File

@ -214,9 +214,7 @@
;;(x-grid (if linechart? (get-option gnc:pagename-display optname-x-grid))) ;;(x-grid (if linechart? (get-option gnc:pagename-display optname-x-grid)))
(commodity-list #f) (commodity-list #f)
(exchange-fn #f) (exchange-fn #f)
(dates-list ((if inc-exp? (dates-list (gnc:make-date-list
gnc:make-date-interval-list
gnc:make-date-list)
((if inc-exp? ((if inc-exp?
gnc:time64-start-day-time gnc:time64-start-day-time
gnc:time64-end-day-time) gnc:time64-end-day-time)
@ -334,26 +332,47 @@
;; reversed according to income-sign-reverse general option ;; reversed according to income-sign-reverse general option
;; settings. Uses the collector->monetary conversion function ;; settings. Uses the collector->monetary conversion function
;; above. Returns a list of gnc-monetary. ;; above. Returns a list of gnc-monetary.
(define (process-datelist accounts dates income?) (define (process-datelist account-balances accounts dates income?)
(map
(lambda (date) (define (get-nth-balance account n)
(collector->monetary (let ((acct-balances (cdr (assoc account account-balances))))
((if inc-exp? (list-ref acct-balances n)))
(if income?
gnc:accounts-get-comm-total-income (define (get-nth-interval account n)
gnc:accounts-get-comm-total-expense) (let ((bal1 (get-nth-balance account n))
gnc:accounts-get-comm-total-assets) (bal2 (get-nth-balance account (1+ n))))
accounts (- bal2 bal1)))
(lambda (account)
(if inc-exp? (define (monetary->collector mon)
;; for inc-exp, 'date' is a pair of time values, else (let ((c (gnc:make-commodity-collector)))
;; it is a time value. (c 'add (gnc:gnc-monetary-commodity mon) (gnc:gnc-monetary-amount mon))
(gnc:account-get-comm-balance-interval c))
account (first date) (second date) #f)
(gnc:account-get-comm-balance-at-date (let loop ((dates dates)
account date #f)))) (dates-idx 0)
(if inc-exp? (second date) date))) (result '()))
dates)) (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) (gnc:report-percent-done 1)
(set! commodity-list (gnc:accounts-get-commodities (set! commodity-list (gnc:accounts-get-commodities
@ -370,36 +389,33 @@
(if (if
(not (null? accounts)) (not (null? accounts))
(let* ((assets-list (process-datelist (let* ((account-balancelist (map account->balancelist accounts))
(assets-list (process-datelist
account-balancelist
(if inc-exp? (if inc-exp?
accounts accounts
(assoc-ref classified-accounts ACCT-TYPE-ASSET)) (assoc-ref classified-accounts ACCT-TYPE-ASSET))
dates-list #t)) dates-list #t))
(liability-list (process-datelist (liability-list (process-datelist
account-balancelist
(if inc-exp? (if inc-exp?
accounts accounts
(assoc-ref classified-accounts ACCT-TYPE-LIABILITY)) (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?
(list-head dates-list (1- (length dates-list)))
dates-list))
;; Here the date strings for the x-axis labels are ;; Here the date strings for the x-axis labels are
;; created. ;; created.
(datelist->stringlist (lambda (dates-list) (datelist->stringlist (lambda (dates-list)
(map (lambda (date-list-item) (map (lambda (date-list-item)
(qof-print-date (qof-print-date date-list-item))
(if inc-exp?
(car date-list-item)
date-list-item)))
dates-list))) dates-list)))
(date-string-list (if linechart? (date-string-list (if linechart?
(datelist->stringlist dates-list) (datelist->stringlist dates-list)
(map (map qof-print-date dates-list)))
(if inc-exp?
(lambda (date-list-item)
(qof-print-date
(car date-list-item)))
qof-print-date)
dates-list)))
(date-iso-string-list (let ((save-fmt (qof-date-format-get)) (date-iso-string-list (let ((save-fmt (qof-date-format-get))
(retlist #f)) (retlist #f))