Hi. the attached patch fixes up some of html-acct-table.scm in an effort (successful!) to speed up the reports that rely on gnc:html-acct-table-add-accounts! (that would be: income-statement, trial-balance, balance-sheet and account-summary).
Though this patch doesn't address *all* the issues with these reports, there is a significant improvement. In my small test file the time to execute a bog-standard income-statement fell from 7.7 seconds to 2.7 seconds. In my large working file the time fell from over 4 minutes to 29 seconds. I assume the other reports would see similar improvements. I have replaced code that recursively calculates balances multiple times with code that calculates balances once, caches them and then looks up the cached balances as needed. thanks for the help on this too guys... A ps. there's a lot of garbage in the patch due to shuffling stuff around. Are there ways to fix this up besides manually picking through the file? and I left a lot of my working comments in, should I kill those and resubmit?
Index: src/report/report-system/html-acct-table.scm
===================================================================
--- src/report/report-system/html-acct-table.scm (revision 16566)
+++ src/report/report-system/html-acct-table.scm (working copy)
@@ -554,6 +554,21 @@
(string<? (gnc-account-get-full-name a)
(gnc-account-get-full-name b)))
+
+;; this is a new version of gnc:html-acct-table-add-accounts!
+;; that is more efficient. it currently only supports:
+;;
+;; income-statement.scm
+;;
+;; hopefully others will follow.
+;; okay, probably now supports all users.
+;;
+;; note that there is lots of dead code in here still that could be
+;; cleaned out but is left for context and to be refactored into
+;; the new code.
+;;
+;; It's messy but way faster.
+;;
(define (gnc:html-acct-table-add-accounts! acct-table accounts)
;;
;; This is where most of the html-acct-table functionality ends up....
@@ -566,7 +581,9 @@
(define (get-val alist key)
(let ((lst (assoc-ref alist key)))
(if lst (car lst) lst)))
-
+
+
+
;; helper to plop <env> in the next available env cell
(define (add-row env)
(let ((html-table (gnc:_html-acct-table-matrix_ acct-table)))
@@ -631,77 +648,135 @@
(logi-depth-reached (if depth-limit (- depth-limit 1) 0))
(disp-depth-reached 0)
)
-
- (define (traverse-accounts! accts acct-depth logi-depth)
+
+ ;; the following function was adapted from html-utilities.scm
+ ;;
+ ;; needs to get its balance-mode functionality factored into
+ ;; calculate balances below.
+ ;; I left this in for reference.
+ ;;
+ ;; there's got to be a prettier way to do this. maybe even make two
+ ;; of these. The balance-mode is only used by trial-balance.scm. so
+ ;; make two versions of this animal, one that cares about balance-mode
+ ;; one that doesn't. then check for a balance-mode !'post-closing and
+ ;; call the right one. later.
+ (define (get-balance-nosub-mode account start-date end-date)
+ (let* ((post-closing-bal
+ (if start-date
+ (gnc:account-get-comm-balance-interval
+ account start-date end-date #f)
+ (gnc:account-get-comm-balance-at-date
+ account end-date #f)))
+ (closing (lambda(a)
+ (gnc:account-get-trans-type-balance-interval
+ (list account) closing-pattern
+ start-date end-date)
+ )
+ )
+ (adjusting (lambda(a)
+ (gnc:account-get-trans-type-balance-interval
+ (list account) adjusting-pattern
+ start-date end-date)
+ )
+ )
+ )
+ ;; what the heck is this? how about (case balance-mode blah...
+ (or (and (equal? balance-mode 'post-closing) post-closing-bal)
+ (and (equal? balance-mode 'pre-closing)
+ (let* ((closing-amt (closing account))
+ )
+ (post-closing-bal 'minusmerge closing-amt #f)
+ post-closing-bal)
+ )
+ (and (equal? balance-mode 'pre-adjusting)
+ (let* ((closing-amt (closing account))
+ (adjusting-amt (adjusting account))
+ )
+ (post-closing-bal 'minusmerge closing-amt #f)
+ (post-closing-bal 'minusmerge adjusting-amt #f)
+ post-closing-bal)
+ )
+ ;; error if we get here.
+ )
+ )
+ )
+
+ ;; helper to calculate the balances for all required accounts
+ ;; currently ignores the *kind* of balance (i.e. balance-mode) to calculate
+ ;; this is the function that doesn't work for the other reports that call the
+ ;; original version of gnc:html-make-acct-table-add-accounts!
+ ;; it needs to have that mess from get-balance-nosub-mode factored into it
+ ;; and then hopefully it will work for other reports.
+ ;;
+ ;; okay, warlord is always right. now we call get-balance-nosub-mode to get the right
+ ;; kind of balance.
+ (define (calculate-balances accts start-date end-date)
+ (if (not (null? accts))
+ (cons (cons (car accts);; (if start-date
+ ;;(gnc:account-get-comm-balance-interval (car accts) start-date end-date #f)
+ ;;(gnc:account-get-comm-balance-at-date (car accts) end-date #f))
+ ;; using the existing function that cares about balance-mode
+ (get-balance-nosub-mode (car accts) start-date end-date))
+ (calculate-balances (cdr accts) start-date end-date))
+ '()
+ )
+ )
+
+
+ (define (traverse-accounts! accts acct-depth logi-depth new-balances)
(define (use-acct? acct)
- ;; BUG? when depth-limit is not integer but boolean?
+ ;; BUG? when depth-limit is not integer but boolean?
(and (or (equal? limit-behavior 'flatten) (< logi-depth depth-limit))
(member acct accounts)
)
)
- ;; the following function was adapted from html-utilities.scm
- (define (my-get-balance-nosub account start-date end-date)
- (let* ((post-closing-bal
- (if start-date
- (gnc:account-get-comm-balance-interval
- account start-date end-date #f)
- (gnc:account-get-comm-balance-at-date
- account end-date #f)))
- (closing (lambda(a)
- (gnc:account-get-trans-type-balance-interval
- (list account) closing-pattern
- start-date end-date)
- )
- )
- (adjusting (lambda(a)
- (gnc:account-get-trans-type-balance-interval
- (list account) adjusting-pattern
- start-date end-date)
- )
- )
+ ;; helper function to return a cached balance from a list of
+ ;; ( acct . balance ) cells
+ ;; this should replace my-get-balance-no-sub in that it returns the
+ ;; balance of an account when we don't care about the children
+ (define (get-balance acct-balances acct)
+ (let ((this-collector (gnc:make-commodity-collector)))
+ (gnc-commodity-collector-merge
+ this-collector
+ (if (not (null? acct-balances))
+ ;; if the acct matches, return the appropriate balance
+ (if (equal? acct (caar acct-balances))
+ (cdar acct-balances)
+ ;; otherwise, keep looking
+ (get-balance (cdr acct-balances) acct))
+ ;; return a zero commodity collector
+ (gnc:make-commodity-collector)
)
- (or (and (equal? balance-mode 'post-closing) post-closing-bal)
- (and (equal? balance-mode 'pre-closing)
- (let* ((closing-amt (closing account))
- )
- (post-closing-bal 'minusmerge closing-amt #f)
- post-closing-bal)
- )
- (and (equal? balance-mode 'pre-adjusting)
- (let* ((closing-amt (closing account))
- (adjusting-amt (adjusting account))
- )
- (post-closing-bal 'minusmerge closing-amt #f)
- (post-closing-bal 'minusmerge adjusting-amt #f)
- post-closing-bal)
- )
- ;; error if we get here.
- )
+ )
+ this-collector
)
)
+
;; Additional function that includes the subaccounts as
;; well. Note: It is necessary to define this here (instead of
;; changing an argument for account-get-balance) because the
;; use-acct? query is needed.
- (define (my-get-balance account start-date end-date)
- ;; this-collector for storing the result
- (let ((this-collector
- (my-get-balance-nosub account start-date end-date)))
+ ;;
+ ;; not anymore. we only look at accounts we use. should move up one level.
+ (define (get-balance-sub acct-balances account)
+ ;; this-collector for storing the result, a nice shiny new
+ ;; collector :-D
+ (let ((this-collector (gnc:make-commodity-collector)))
+ ;; get the balance of the parent account and stick it on the collector
+ ;; that nice shiny *NEW* collector!!
+ (gnc-commodity-collector-merge this-collector (get-balance acct-balances account))
(for-each
(lambda (x) (if x (gnc-commodity-collector-merge this-collector x)))
(gnc:account-map-descendants
(lambda (a)
- ;; Important: Calculate the balance if and only if the
- ;; account a is shown, i.e. (use-acct? a) == #t.
- (and (use-acct? a)
- (my-get-balance-nosub a start-date end-date)))
+ (get-balance acct-balances a ))
account))
this-collector))
-
+
(let ((disp-depth
(if (integer? depth-limit)
(min (- depth-limit 1) logi-depth)
@@ -730,15 +805,15 @@
(account-guid (gncAccountGetGUID acct))
(account-description (xaccAccountGetDescription acct))
(account-notes (xaccAccountGetNotes acct))
- ;; These next two are commodity-collectors.
- (account-bal (my-get-balance-nosub
- acct start-date end-date))
- (recursive-bal (my-get-balance
- acct start-date end-date))
- ;; These next two are of type <gnc:monetary>, right?
+ ;; These next two are commodity-collectors.
+ (account-bal (get-balance
+ new-balances acct))
+ (recursive-bal (get-balance-sub
+ new-balances acct))
+ ;; These next two are of type <gnc:monetary>, right?
(report-comm-account-bal
- (gnc:sum-collector-commodity
- account-bal report-commodity exchange-fn))
+ (gnc:sum-collector-commodity
+ account-bal report-commodity exchange-fn))
(report-comm-recursive-bal
(gnc:sum-collector-commodity
recursive-bal report-commodity exchange-fn))
@@ -777,6 +852,7 @@
(gnc:make-html-text account-name))
))
)
+
(set! acct-depth-reached (max acct-depth-reached acct-depth))
(set! logi-depth-reached (max logi-depth-reached logi-depth))
(set! disp-depth-reached (max disp-depth-reached disp-depth))
@@ -799,16 +875,17 @@
(add-row row-env)
)
)
- ;; Recurse:
+ ;; Recurse:
;; Dive into an account even if it isnt selected!
+ ;; why? because some subaccts may be selected?
(traverse-accounts! subaccts
(+ acct-depth 1)
(if (use-acct? acct)
(+ logi-depth 1)
logi-depth)
- )
+ new-balances)
- ;; after the return from recursion: subtotals
+ ;; after the return from recursion: subtotals
(or (not (use-acct? acct))
(not subtotal-mode)
;; ditto that remark concerning zero recursive-bal...
@@ -840,17 +917,15 @@
)
)) ;; end of (lambda (acct) ...)
;; lambda is applied to each item in the (sorted) account list
- (if less-p
+ (if less-p
(sort accts less-p)
accts)
) ;; end of for-each
- )
+ )
) ;; end of definition of traverse-accounts!
- ;;(display (list "END-DATE: " end-date))
-
;; do it
- (traverse-accounts! toplvl-accts 0 0)
+ (traverse-accounts! toplvl-accts 0 0 (calculate-balances accounts start-date end-date))
;; set the column-header colspan
(if gnc:colspans-are-working-right
signature.asc
Description: Digital signature
_______________________________________________ gnucash-devel mailing list [email protected] https://lists.gnucash.org/mailman/listinfo/gnucash-devel
