mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[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:
parent
cacb15c3f3
commit
ab97eed979
@ -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))
|
||||||
|
Loading…
Reference in New Issue
Block a user