From 6c59cd15cdafc490892349127a5af871436f91ec Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 17 Oct 2018 17:52:18 +0800 Subject: [PATCH] [category-barchart] Deoptimize category-barchart This aims to partially undo commit 8aed5c3f660, and removes dependency unto collectors and report-collectors. --- .../standard-reports/category-barchart.scm | 110 +++++++++++------- 1 file changed, 66 insertions(+), 44 deletions(-) diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm index ba23a977b8..b3b91298bc 100644 --- a/gnucash/report/standard-reports/category-barchart.scm +++ b/gnucash/report/standard-reports/category-barchart.scm @@ -24,8 +24,6 @@ ;; depends must be outside module scope -- and should eventually go away. (define-module (gnucash report standard-reports category-barchart)) -(use-modules (gnucash report report-system report-collectors)) -(use-modules (gnucash report report-system collectors)) (use-modules (srfi srfi-1)) (use-modules (gnucash utilities)) (use-modules (gnucash gnc-module)) @@ -263,6 +261,8 @@ developing over time")) (sort-method (get-option gnc:pagename-display optname-sort-method)) (reverse-balance? (get-option "__report" "reverse-balance?")) + (work-done 0) + (work-to-do 0) (show-table? (get-option gnc:pagename-display (N_ "Show table"))) (document (gnc:make-html-document)) (chart @@ -285,16 +285,8 @@ developing over time")) (gnc:get-current-account-tree-depth) account-levels)) - (define the-acount-destination-alist - (account-destination-alist accounts account-types tree-depth)) - ;;(gnc:debug accounts) (if (not (null? accounts)) - (if (null? the-acount-destination-alist) - (gnc:html-document-add-object! - document - (gnc:html-make-empty-data-warning - report-title (gnc:report-id report-obj))) ;; Define more helper variables. (let* ((commodity-list #f) @@ -404,6 +396,34 @@ developing over time")) ((list? data) (myor (map not-all-zeros data))) (else #f))) + ;; Calculates the net balance (profit or loss) of an account in + ;; the given time interval. date-list-entry is a pair containing + ;; the start- and end-date of that interval. If subacct?==#t, + ;; the subaccount's balances are included as well. Returns a + ;; double, exchanged into the report-currency by the above + ;; conversion function, and possibly with reversed sign. + (define (get-balance account date-list-entry subacct?) + ((if (reverse-balance? account) + gnc:monetary-neg identity) + (if do-intervals? + (collector->monetary + (gnc:account-get-comm-balance-interval + account + (first date-list-entry) + (second date-list-entry) subacct?) + (second date-list-entry)) + (collector->monetary + (gnc:account-get-comm-balance-at-date + account date-list-entry subacct?) + date-list-entry)))) + +;; Creates the to be used in the function + ;; below. + (define (account->balance-list account subacct?) + (map + (lambda (d) (get-balance account d subacct?)) + dates-list)) + (define (count-accounts current-depth accts) (if (< current-depth tree-depth) (let ((sum 0)) @@ -429,34 +449,33 @@ developing over time")) ;; show-acct? is true. This is necessary because otherwise we ;; would forget an account that is selected but not its ;; parent. - (define (apply-sign account x) - (if (reverse-balance? account) (gnc:monetary-neg x) x)) - (define (calculate-report accounts progress-range) - (let* ((account-reformat - (if do-intervals? - (lambda (account result) - (map (lambda (collector datepair) - (let ((date (second datepair))) - (apply-sign account (collector->monetary collector date)))) - result dates-list)) - (lambda (account result) - (let ((commodity-collector (gnc:make-commodity-collector))) - (collector-end (fold (lambda (next date list-collector) - (commodity-collector 'merge next #f) - (collector-add list-collector - (apply-sign account - (collector->monetary commodity-collector - date)))) - (collector-into-list) - result dates-list)))))) - - (the-work (category-by-account-report-work do-intervals? - dates-list the-acount-destination-alist - (lambda (account date) - (make-gnc-collector-collector)) - account-reformat)) - (the-report (category-by-account-report-do-work the-work progress-range))) - the-report)) + (define (traverse-accounts current-depth accts) + (if (< current-depth tree-depth) + (let ((res '())) + (for-each + (lambda (a) + (begin + (set! work-done (1+ work-done)) + (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do)))) + (if (show-acct? a) + (set! res + (cons (list a (account->balance-list a #f)) + res))) + (set! res (append + (traverse-accounts + (+ 1 current-depth) + (gnc-account-get-children a)) + res)))) + accts) + res) + ;; else (i.e. current-depth == tree-depth) + (map + (lambda (a) + (set! work-done (1+ work-done)) + (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do)))) + (list a (account->balance-list a #t))) + (filter show-acct? accts)))) + ;; The percentage done numbers here are a hack so that ;; something gets displayed. On my system the @@ -476,12 +495,15 @@ developing over time")) commodity-list to-date-t64 5 15)) + (set! work-to-do (count-accounts 1 topl-accounts)) + ;; Sort the account list according to the account code field. - (set! all-data (sort - (filter (lambda (l) - (not (gnc-numeric-equal (gnc-numeric-zero) - (gnc:gnc-monetary-amount (apply monetary+ (cadr l)))))) - (calculate-report accounts (cons 0 90))) + (set! all-data (sort + (filter (lambda (l) + (not (zero? + (gnc:gnc-monetary-amount + (apply monetary+ (cadr l)))))) + (traverse-accounts 1 topl-accounts)) (cond ((eq? sort-method 'acct-code) (lambda (a b) @@ -783,7 +805,7 @@ developing over time")) (gnc:html-document-add-object! document (gnc:html-make-empty-data-warning - report-title (gnc:report-id report-obj)))))) + report-title (gnc:report-id report-obj))))) ;; else if no accounts selected (gnc:html-document-add-object!