Reports: Speed up the report infrastructure. Patch by Mike Alexander.

One set of changes speeds up the three functions in report-utilities.scm:
gnc:account-get-comm-balance-interval
gnc:accountlist-get-comm-balance-interval
gnc:accountlist-get-comm-balance-at-date

These can all be implemented as calls to
gnc:account-get-trans-type-balance-interval (with a minor change to it to
ignore the type parameter if it is #f) and it is much faster since it does a
single query instead of a loop over an account list.

The other set of changes is in gnc:html-acct-table-add-accounts! in
html-acct-table.scm.  This functions starts off by building a hash table of
account balances it cares about.  The code to do this did a recursive loop over
the relevant accounts.  I changed it to do a query to find the splits in the
accounts it cares about and build the hash table from them.  This speeds it up
by a couple of orders of magnitude.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@17988 57a11ea4-9604-0410-9ed3-97b8803252fd

src/report/report-system/html-acct-table.scm

@@ -638,74 +638,71 @@
 
     ;; the following function was adapted from html-utilities.scm
     ;; 
-    ;;
-    ;; 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)
-			  )
-			)
-	     )
-
-	(cond
-	 ((equal? balance-mode 'post-closing)
-	  post-closing-bal)
-
-	 ((equal? balance-mode 'pre-closing)
-	  (let* ((closing-amt (closing account))
-		 )
-	    (post-closing-bal 'minusmerge closing-amt #f))
-	  post-closing-bal)
-
-	 ((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)
-	 (else (begin (display "you fail it")
-		      (newline))))
-
-	)
-      )
 
     ;; helper to calculate the balances for all required accounts
     (define (calculate-balances accts start-date end-date get-balance-fn)
       (define (calculate-balances-helper accts start-date end-date acct-balances)
         (if (not (null? accts))
             (begin
-                ;; using the existing function that cares about balance-mode
+              ;; using the existing function that cares about balance-mode
-                ;; maybe this should get replaces at some point.
+              ;; maybe this should get replaces at some point.
-                (hash-set! acct-balances (gncAccountGetGUID (car accts))
+              (hash-set! acct-balances (gncAccountGetGUID (car accts))
-                    (get-balance-fn (car accts) start-date end-date))
+                         (get-balance-fn (car accts) start-date end-date))
-                (calculate-balances-helper (cdr accts) start-date end-date acct-balances)
+              (calculate-balances-helper (cdr accts) start-date end-date acct-balances)
-            )
+              )
             acct-balances)
         )
-        
-      (calculate-balances-helper accts start-date end-date
-                                 (make-hash-table 23))                                 
-      )
 
+      (define (calculate-balances-simple accts start-date end-date hash-table)
+        (define (merge-splits splits subtract?)
+          (for-each
+           (lambda (split)
+             (let* ((acct (xaccSplitGetAccount split))
+                    (guid (gncAccountGetGUID acct))
+                    (acct-comm (xaccAccountGetCommodity acct))
+                    (shares (xaccSplitGetAmount split))
+                    (hash (hash-ref hash-table guid)))
+;                (gnc:debug "Merging split for " (xaccAccountGetName acct) " for "
+;                           (gnc-commodity-numeric->string acct-comm shares)
+;                           " into hash entry " hash)
+               (if (not hash)
+                   (begin (set! hash (gnc:make-commodity-collector))
+                          (hash-set! hash-table guid hash)))
+               (hash 'add acct-comm (if subtract?
+                                        (gnc-numeric-neg shares)
+                                        shares))))
+           splits))
+
+        (merge-splits (gnc:account-get-trans-type-splits-interval
+                       accts #f start-date end-date)
+                      #f)
+        (cond
+         ((equal? balance-mode 'post-closing) #t)
+
+         ((equal? balance-mode 'pre-closing)
+          (merge-splits (gnc:account-get-trans-type-splits-interval
+                         accts closing-pattern start-date end-date)
+                        #t))
+
+         ((equal? balance-mode 'pre-adjusting)
+          (merge-splits (gnc:account-get-trans-type-splits-interval
+                         accts closing-pattern start-date end-date)
+                        #t)
+          (merge-splits (gnc:account-get-trans-type-splits-interval
+                         accts adjusting-pattern start-date end-date)
+                        #t))
+         (else (begin (display "you fail it")
+                      (newline))))
+        hash-table
+        )
+
+      (if get-balance-fn
+          (calculate-balances-helper accts start-date end-date
+                                     (make-hash-table 23))                               
+          (calculate-balances-simple accts start-date end-date
+                                     (make-hash-table 23))                               
+          )
+      )
 
     (define (traverse-accounts! accts acct-depth logi-depth new-balances)
       
@@ -900,7 +897,8 @@
       ) ;; end of definition of traverse-accounts!
 
     ;; do it
-    (traverse-accounts! toplvl-accts 0 0 (calculate-balances accounts start-date end-date (or get-balance-fn get-balance-nosub-mode)))
+    (traverse-accounts! toplvl-accts 0 0
+                        (calculate-balances accounts start-date end-date get-balance-fn))
     
     ;; set the column-header colspan
     (if gnc:colspans-are-working-right

src/report/report-system/report-system.scm

@@ -663,6 +663,7 @@
 (export gnc-commodity-collector-allzero?)
 (export gnc:account-get-trans-type-balance-interval)
 (export gnc:account-get-pos-trans-total-interval)
+(export gnc:account-get-trans-type-splits-interval)
 (export gnc:double-col)
 (export gnc:budget-get-start-date)
 (export gnc:budget-account-get-net)

src/report/report-system/report-utilities.scm

@@ -624,39 +624,22 @@
 ;; the version which returns a commodity-collector
 (define (gnc:account-get-comm-balance-interval 
 	 account from to include-children?)
-  ;; Since this function calculates a balance difference it has to
+  (let ((account-list (if include-children?
-  ;; subtract the balance of the previous day's end (from-date)
+                          (let ((sub-accts (gnc-account-get-descendants-sorted account)))
-  ;; instead of the plain date.
+                            (if sub-accts
-  (let ((this-collector (gnc:account-get-comm-balance-at-date 
+                                (append (list account) sub-accts)
-			 account to include-children?)))
+                                (list account)))
-    (gnc-commodity-collector-minusmerge
+                          (list account))))
-     this-collector
+    (gnc:account-get-trans-type-balance-interval account-list #f from to)))
-     (gnc:account-get-comm-balance-at-date
-      account
-      (gnc:timepair-end-day-time (gnc:timepair-previous-day from))
-      include-children?))
-    this-collector))
 
 ;; This calculates the increase in the balance(s) of all accounts in
 ;; <accountlist> over the period from <from-date> to <to-date>.
 ;; Returns a commodity collector.
 (define (gnc:accountlist-get-comm-balance-interval accountlist from to)
-  (let ((collector (gnc:make-commodity-collector)))
+  (gnc:account-get-trans-type-balance-interval accountlist #f from to))
-    (for-each (lambda (account)
-                (gnc-commodity-collector-merge
-                 collector (gnc:account-get-comm-balance-interval 
-                            account from to #f)))
-              accountlist)
-    collector))
 
 (define (gnc:accountlist-get-comm-balance-at-date accountlist date)
-   (let ((collector (gnc:make-commodity-collector)))
+  (gnc:account-get-trans-type-balance-interval accountlist #f #f date))
-    (for-each (lambda (account)
-                (gnc-commodity-collector-merge
-                 collector (gnc:account-get-comm-balance-at-date 
-                            account date #f)))
-              accountlist)
-    collector))
 
 ;; utility function - ensure that a query matches only non-voids.  Destructive.
 (define (gnc:query-set-match-non-voids-only! query book)
@@ -720,40 +703,21 @@
 
 ;; Sums up any splits of a certain type affecting a set of accounts.
 ;; the type is an alist '((str "match me") (cased #f) (regexp #f))
+;; If type is #f, sums all splits in the interval
 (define (gnc:account-get-trans-type-balance-interval
 	 account-list type start-date-tp end-date-tp)
-  (let* ((query (qof-query-create-for-splits))
+  (let* ((total (gnc:make-commodity-collector)))
-	 (splits #f)
-	 (get-val (lambda (alist key)
-		    (let ((lst (assoc-ref alist key)))
-		      (if lst (car lst) lst))))
-	 (matchstr (get-val type 'str))
-	 (case-sens (if (get-val type 'cased) #t #f))
-	 (regexp (if (get-val type 'regexp) #t #f))
-	 (total (gnc:make-commodity-collector))
-	 )
-    (qof-query-set-book query (gnc-get-current-book))
-    (gnc:query-set-match-non-voids-only! query (gnc-get-current-book))
-    (xaccQueryAddAccountMatch query account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
-    (xaccQueryAddDateMatchTS
-     query
-     (and start-date-tp #t) start-date-tp
-     (and end-date-tp #t) end-date-tp QOF-QUERY-AND)
-    (xaccQueryAddDescriptionMatch
-     query matchstr case-sens regexp QOF-QUERY-AND)
-    
-    (set! splits (qof-query-run query))
     (map (lambda (split)
-		(let* ((shares (xaccSplitGetAmount split))
+           (let* ((shares (xaccSplitGetAmount split))
-		       (acct-comm (xaccAccountGetCommodity
+                  (acct-comm (xaccAccountGetCommodity
-				   (xaccSplitGetAccount split)))
+                              (xaccSplitGetAccount split)))
-		       )
+                  )
-		  (gnc-commodity-collector-add total acct-comm shares)
+             (gnc-commodity-collector-add total acct-comm shares)
-		  )
+             )
-		)
+           )
-	 splits
+	 (gnc:account-get-trans-type-splits-interval
+          account-list type start-date-tp end-date-tp)
 	 )
-    (qof-query-destroy query)
     total
     )
   )
@@ -820,6 +784,35 @@
     )
   )
 
+;; Return the splits that match an account list, date range, and (optionally) type
+;; where type is defined as an alist '((str "match me") (cased #f) (regexp #f))
+(define (gnc:account-get-trans-type-splits-interval
+         account-list type start-date-tp end-date-tp)
+  (let* ((query (qof-query-create-for-splits))
+	 (splits #f)
+	 (get-val (lambda (alist key)
+		    (let ((lst (assoc-ref alist key)))
+		      (if lst (car lst) lst))))
+	 (matchstr (get-val type 'str))
+	 (case-sens (if (get-val type 'cased) #t #f))
+	 (regexp (if (get-val type 'regexp) #t #f))
+	 )
+    (qof-query-set-book query (gnc-get-current-book))
+    (gnc:query-set-match-non-voids-only! query (gnc-get-current-book))
+    (xaccQueryAddAccountMatch query account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
+    (xaccQueryAddDateMatchTS
+     query
+     (and start-date-tp #t) start-date-tp
+     (and end-date-tp #t) end-date-tp QOF-QUERY-AND)
+    (if type (xaccQueryAddDescriptionMatch
+              query matchstr case-sens regexp QOF-QUERY-AND))
+    
+    (set! splits (qof-query-run query))
+    (qof-query-destroy query)
+    splits
+    )
+  )
+
 ;; utility to assist with double-column balance tables
 ;; a request is made with the <req> argument
 ;; <req> may currently be 'entry|'debit-q|'credit-q|'zero-q|'debit|'credit