Merge 5a82035615 into 5ce3a9dd1d

gnucash/report/reports/standard/budget.scm

@@ -35,6 +35,7 @@
 
 (use-modules (srfi srfi-1))
 (use-modules (ice-9 match))
+(use-modules (ice-9 receive))
 
 (define trep-uuid "2fe3b9833af044abb929a88d5a59620f")
 
@@ -60,12 +61,13 @@
 (define opthelp-show-difference (N_ "Display the difference as budget - actual."))
 (define optname-accumulate (N_ "Use accumulated amounts"))
 (define opthelp-accumulate (N_ "Values are accumulated across periods."))
+(define optname-rollover (N_ "Roll over difference"))
+(define opthelp-rollover (N_ "Budget period surplus or deficit is rolled over to next period."))
 (define optname-show-totalcol (N_ "Show Column with Totals"))
 (define opthelp-show-totalcol (N_ "Display a column with the row totals."))
 (define optname-show-zb-accounts (N_ "Include accounts with zero total balances and budget values"))
 (define opthelp-show-zb-accounts (N_ "Include accounts with zero total (recursive) balances and budget values in this report."))
 
-
 (define optname-use-budget-period-range
   (N_ "Report for range of budget periods"))
 (define opthelp-use-budget-period-range
@@ -94,6 +96,9 @@
 (define opthelp-bottom-behavior
   (N_ "Displays accounts which exceed the depth limit at the depth limit."))
 
+(define optname-selected-only (N_ "Exclude unselected amounts"))
+(define opthelp-selected-only (N_ "Accounts not displayed will not be counted in their parent account values."))
+
 (define optname-budget (N_ "Budget"))
 
 ;;List of common helper functions, that is not bound only to options generation or report evaluation
@@ -123,9 +128,17 @@
       "a" (N_ "Budget to use.")
       (gnc-budget-get-default (gnc-get-current-book)))
 
-    (gnc-register-simple-boolean-option options
+    (gnc-register-complex-boolean-option options
       gnc:pagename-general optname-accumulate
-      "b" opthelp-accumulate #f)
+      "b1" opthelp-accumulate #f
+      (lambda (new-val)
+        (set-option-enabled options gnc:pagename-general optname-rollover (eqv? new-val #f))))
+
+    (gnc-register-complex-boolean-option options
+      gnc:pagename-general optname-rollover
+      "b2" opthelp-rollover #f
+      (lambda (new-val)
+        (set-option-enabled options gnc:pagename-general optname-accumulate (eqv? new-val #f))))
 
     (gnc-register-complex-boolean-option options
       gnc:pagename-general optname-use-budget-period-range
@@ -204,6 +217,10 @@
       gnc:pagename-accounts optname-bottom-behavior
       "c" opthelp-bottom-behavior #f)
 
+    (gnc-register-simple-boolean-option options
+      gnc:pagename-accounts optname-selected-only
+      "d" opthelp-selected-only #f)
+
     ;; columns to display
     (gnc-register-complex-boolean-option options
       gnc:pagename-display optname-show-budget
@@ -277,8 +294,11 @@
          (show-note? (get-val params 'show-note))
          (footnotes (get-val params 'footnotes))
          (accumulate? (get-val params 'use-envelope))
+         (rollover? (get-val params 'rollover))
          (show-totalcol? (get-val params 'show-totalcol))
          (use-ranges? (get-val params 'use-ranges))
+         (accounts (get-val params 'accounts))
+         (selected-only? (get-val params 'selected-only))
          (num-rows (gnc:html-acct-table-num-rows acct-table))
          (numcolumns (gnc:html-table-num-columns html-table))
          ;; WARNING: we implicitly depend here on the details of
@@ -288,8 +308,8 @@
          ;; assumption.
          (colnum (quotient numcolumns 2)))
 
-    ;; Calculate the value to use for the budget of an account for a
+    ;; Calculate the naive value to use for the budget of an account for
-    ;; specific set of periods.  If there is 1 period, use that
+    ;; a specific set of periods.  If there is 1 period, use that
     ;; period's budget value.  Otherwise, sum the budgets for all of
     ;; the periods.
     ;;
@@ -300,15 +320,54 @@
     ;;
     ;; Return value:
     ;;   Budget sum
-    (define (gnc:get-account-periodlist-budget-value budget acct periodlist)
+    (define (gnc:get-single-account-periodlist-budget-value budget acct periodlist)
       (apply +
              (map
               (lambda (period)
                 (gnc:get-account-period-rolledup-budget-value budget acct period))
               periodlist)))
+
+    ;; Calculate the value to use for the budget of an account for
+    ;; a specific set of periods, including offsets for any
+    ;; unselected accounts if 'selected-only?' is true.
+    ;;
+    ;; Parameters:
+    ;;   budget - budget to use
+    ;;   acct - account
+    ;;   periodlist - list of budget periods to use
+    ;;
+    ;; Return value:
+    ;;   Budget sum
+    (define (gnc:get-account-periodlist-budget-value budget acct periodlist)
+      (receive
+        (subtract-accts add-accts) (descendant-additions-subtractions acct accounts)
+        (let
+          ((acct-budget-val
+             (gnc:get-single-account-periodlist-budget-value
+               budget acct periodlist))
+            (subtract-budget-offset-val
+              (if selected-only?
+                (apply +
+                  (map
+                    (lambda (sub-acct)
+                      (gnc:get-single-account-periodlist-budget-value
+                        budget sub-acct periodlist))
+                    subtract-accts))
+                0))
+            (add-budget-offset-val
+              (if selected-only?
+                (apply +
+                  (map
+                    (lambda (add-acct)
+                      (gnc:get-single-account-periodlist-budget-value
+                        budget add-acct periodlist))
+                    add-accts))
+                0)))
+          (+ (- acct-budget-val subtract-budget-offset-val)
+            add-budget-offset-val))))
     
-    ;; Calculate the value to use for the actual of an account for a
+    ;; Calculate the naive value to use for the actual of an account for
-    ;; specific set of periods.  This is the sum of the actuals for
+    ;; a specific set of periods.  This is the sum of the actuals for
     ;; each of the periods.
     ;;
     ;; Parameters:
@@ -318,12 +377,153 @@
     ;;
     ;; Return value:
     ;;   Budget sum
-    (define (gnc:get-account-periodlist-actual-value budget acct periodlist)
+    (define (gnc:get-single-account-periodlist-actual-value budget acct periodlist)
       (apply + (map
                 (lambda (period)
-                  (gnc-budget-get-account-period-actual-value budget acct period))
+                  (gnc-budget-get-account-period-actual-value
+                    budget acct period))
                 periodlist)))
 
+    ;; Calculate the value to use for the actual of an account for
+    ;; a specific set of periods, including offsets for any
+    ;; unselected accounts if 'selected-only?' is true.
+    ;;
+    ;; Parameters:
+    ;;   budget - budget to use
+    ;;   acct - account
+    ;;   periodlist - list of budget periods to use
+    ;;
+    ;; Return value:
+    ;;   Budget sum
+    (define (gnc:get-account-periodlist-actual-value budget acct periodlist)
+      (receive
+        (subtract-accts add-accts) (descendant-additions-subtractions acct accounts)
+        (let
+          ((acct-actual-val
+             (gnc:get-single-account-periodlist-actual-value
+               budget acct periodlist))
+            (subtract-actual-offset-val
+              (if selected-only?
+                (apply +
+                  (map
+                    (lambda (sub-acct)
+                      (gnc:get-single-account-periodlist-actual-value
+                        budget sub-acct periodlist))
+                    subtract-accts))
+                0))
+            (add-actual-offset-val
+              (if selected-only?
+                (apply +
+                  (map
+                    (lambda (add-acct)
+                      (gnc:get-single-account-periodlist-actual-value
+                        budget add-acct periodlist))
+                    add-accts))
+                0)))
+          (+ (- acct-actual-val subtract-actual-offset-val)
+            add-actual-offset-val))))
+
+
+    ;; Get descendant accounts to add or subtract
+    ;; If we want to exclude the amounts in unselected accounts from their parent totals,
+    ;; this function will return lists of accounts whose totals need to be subtracted from
+    ;; and added to the ancestor account balance.
+    ;;
+    ;; Consider the following account structure and display selections:
+    ;; [x] Expenses
+    ;;   [ ] Education
+    ;;     [ ] Tuition
+    ;;   [x] Bills
+    ;;     [ ] Utilities
+    ;;       [x] Phone
+    ;;       [ ] Internet
+    ;;     [x] House
+    ;;       [x] Mortgage
+    ;;       [ ] HOA
+    ;;
+    ;; We want to display a total for Expenses, but without Education or HOA, and without
+    ;; Utilities except for Phone. To determine our add/subtract account lists we walk the
+    ;; account structure, building the lists according to the following rules:
+    ;;   1. If the account is selected and its parent is selected, its value is already
+    ;;      included in its parent so it doesn't go on either list
+    ;;   2. If the account is not selected but its parent is, we need to subtract it to
+    ;;      offset its amount in the parent
+    ;;   3. If the account is not selected and neither is its parent, its value has already
+    ;;      been offset so it doesn't go on either list
+    ;;   4. If the account is selected but its parent is not selected, then the total of its
+    ;;      parent account was subtracted, so we need to add its amount
+    ;;
+    ;; In the above example, we would subtract Education, Utilities, and HOA; and we would
+    ;; add Phone.
+    ;;
+    ;; Parameters:
+    ;;   acct - account to compute additions and subtractions in descendant accounts for
+    ;;   selected-accts - list of all accounts that are selected
+    ;;
+    ;; Return value:
+    ;;   Two lists: (1) accounts to subtract balances of, and (2) accounts to add balances of
+    (define (descendant-additions-subtractions acct selected-accts)
+      ;; construct is-selected-acct function for efficient lookup from selected-accts
+      (define (map-accts-by-guid acct-list)
+        (define accts-map (make-hash-table (length acct-list)))
+        (for-each
+          (lambda (acct)
+            (hash-set! accts-map (gncAccountGetGUID acct) acct))
+          acct-list)
+        accts-map)
+      (define selected-accts-map (map-accts-by-guid selected-accts))
+      (define (is-selected acct)
+        (not (eq? (hash-ref selected-accts-map
+                    (gncAccountGetGUID acct) 'not-found) 'not-found)))
+
+      (define (get-add-subtract-descendants-helper cur-acct is-root)
+        (define result '())
+        (let ((parent-acct (gnc-account-get-parent cur-acct))
+               (children-accts (gnc-account-get-children-sorted cur-acct)))
+          (cond
+            ;; if this account is selected and its parent is (or we're on the root
+            ;;   account, ignoring parent) no need to do anything, this account is
+            ;;   already included in its parent total
+            ((and (is-selected cur-acct) (or (is-selected parent-acct) is-root)) #f)
+            ;; same deal if neither this one or its parent are selected: we've
+            ;;   already subtracted the total of the parent account including this
+            ;;   one so no need to do anything
+            ((and (not (is-selected cur-acct)) (not (is-selected parent-acct))) #f)
+            ;; if this account is selected but its parent is not we need to add this
+            ;;   account to the 'add-accts' list since its value is not included in
+            ;    its parent
+            ((and (is-selected cur-acct) (not (is-selected parent-acct)))
+              (set! result (cons (list 'add-acct cur-acct) result)))
+            ;; if this account is not selected but its parent is, we need to add it
+            ;;   to the 'subtract-accts' list since its value needs to be subtracted
+            ;;   from the parent total
+            ((and (not (is-selected cur-acct)) (is-selected parent-acct))
+              (set! result (cons (list 'subtract-acct cur-acct) result))))
+          ;; recurse into children
+          (for-each
+            (lambda (child)
+              (set! result (append result
+                             (get-add-subtract-descendants-helper child #f))))
+            children-accts))
+        result)
+
+      ;; call main logic in get-add-subtract-descendants-helper, then build list
+      ;; of lists into flat subtract-accts and add-accts lists
+      (define acct-actions (get-add-subtract-descendants-helper acct #t ))
+      (define subtract-accts '())
+      (define add-accts '())
+      (for-each
+        (lambda (item)
+          (cond
+            ((eq? (car item) 'add-acct)
+              (set! add-accts (cons (second item) add-accts)))
+            ((eq? (car item) 'subtract-acct)
+              (set! subtract-accts (cons (second item) subtract-accts)))))
+        acct-actions)
+
+      (values subtract-accts add-accts))
+
+
     ;; Adds a line to the budget report.
     ;;
     ;; Parameters:
@@ -340,7 +540,7 @@
              (reverse-balance? (gnc-reverse-balance acct))
              (maybe-negate (lambda (amt) (if reverse-balance? (- amt) amt)))
              (allperiods (filter number? (gnc:list-flatten column-list)))
-             (total-periods (if (and accumulate? (not (null? allperiods)))
+             (total-periods (if (and (or accumulate? rollover?) (not (null? allperiods)))
                                 (iota (1+ (apply max allperiods)))
                                 allperiods))
              (income-acct? (eqv? (xaccAccountGetType acct) ACCT-TYPE-INCOME)))
@@ -415,25 +615,50 @@
                                bgt-total act-total dif-total #f))))
 
            (else
-            (let* ((period-list (cond
+            (let*
-                                 ((list? (car column-list)) (car column-list))
+              ((period-list
-                                 (accumulate? (iota (1+ (car column-list))))
+                 (cond
-                                 (else (list (car column-list)))))
+                  ;; if this column is a range of periods, use that list
-                   (note (and (= 1 (length period-list))
+                  ;; TODO: is it a bug or intended behavior to not include previous periods here when accumulate is true?
-                              (gnc-budget-get-account-period-note
+                  ((list? (car column-list)) (car column-list))
-                               budget acct (car period-list))))
+                  ;; if we're accumulating or rolling over budget, use all periods up
-                   (bgt-val (maybe-negate
+                  ;; until the indicated one
-                             (gnc:get-account-periodlist-budget-value
+                  ((or accumulate? rollover?) (iota (1+ (car column-list))))
-                              budget acct period-list)))
+                  ;; otherwise our period list has a single element: the indicated period
-                   (act-val (maybe-negate
+                  (else (list (car column-list)))))
-                             (gnc:get-account-periodlist-actual-value
+                ;; build a list of all previous periods to use in rollover offset if
-                              budget acct period-list)))
+                ;; we're rolling over
-                   (dif-val (- bgt-val act-val)))
+                (period-list-prev
-              (loop (cdr column-list)
+                  (cond
-                    (disp-cols "number-cell" current-col acct
+                    ((and rollover?
-                               (gnc-budget-get-period-start-date budget (car period-list))
+                       (list? (car column-list))) (iota (car (car column-list))))
-                               (gnc-budget-get-period-end-date budget (car period-list))
+                    (rollover? (iota (car column-list)))
-                               bgt-val act-val dif-val note))))))))
+                    (else '())))
+                (note (and (= 1 (length period-list))
+                           (gnc-budget-get-account-period-note
+                            budget acct (car period-list))))
+                ;; total budget for all periods in period-list
+                (bgt-val-all (gnc:get-account-periodlist-budget-value
+                               budget acct period-list))
+                ;; total actuals for any periods being used in a rollover offset
+                (act-val-prev (gnc:get-account-periodlist-actual-value
+                                budget acct period-list-prev))
+                ;; budget value: total for period-list minus any offset
+                (bgt-val (maybe-negate
+                           (- bgt-val-all act-val-prev)))
+                ;; total actual for period-list
+                (act-val-all (gnc:get-account-periodlist-actual-value
+                              budget acct period-list))
+                ;; actual value: total for period-list minus any offset
+                (act-val (maybe-negate
+                          (- act-val-all act-val-prev)))
+                (dif-val (- bgt-val act-val)))
+              (loop
+                (cdr column-list)
+                (disp-cols "number-cell" current-col acct
+                  (gnc-budget-get-period-start-date budget (car period-list))
+                  (gnc-budget-get-period-end-date budget (car period-list))
+                  bgt-val act-val dif-val note))))))))
 
     ;; Adds header rows to the budget report.  The columns are
     ;; specified by the column-list parameter.
@@ -689,6 +914,7 @@
                    (list 'report-budget budget)))
              (accounts (sort accounts gnc:account-full-name<?))
              (accumulate? (get-option gnc:pagename-general optname-accumulate))
+             (rollover? (get-option gnc:pagename-general optname-rollover))
              (acct-table (gnc:make-html-acct-table/env/accts env accounts))
              (footnotes (make-footnote-collector))
              (paramsBudget
@@ -706,6 +932,7 @@
                           (get-option gnc:pagename-display optname-show-notes)))
                (list 'footnotes footnotes)
                (list 'use-envelope accumulate?)
+               (list 'rollover rollover?)
                (list 'show-totalcol
                      (get-option gnc:pagename-display optname-show-totalcol))
                (list 'use-ranges use-ranges?)
@@ -720,7 +947,10 @@
                (list 'user-start-period-exact
                      (to-period-val optname-budget-period-start-exact))
                (list 'user-end-period-exact
-                     (to-period-val optname-budget-period-end-exact))))
+                     (to-period-val optname-budget-period-end-exact))
+               (list 'accounts accounts)
+               (list 'selected-only
+                     (get-option gnc:pagename-accounts optname-selected-only))))
              (report-name (get-option gnc:pagename-general
                                       gnc:optname-reportname)))
 
@@ -731,8 +961,10 @@
                      ;; budget will report on budgeted and actual
                      ;; amounts from the beginning of budget, instead
                      ;; of only using the budget-period amounts.
-                     (if accumulate? (G_ "using accumulated amounts")
+                     (cond
-                         "")))
+                       (accumulate? (G_ "using accumulated amounts"))
+                       (rollover? (G_ "using budget rollover"))
+                       (else ""))))
 
         ;; We do this in two steps: First the account names...  the
         ;; add-account-balances will actually compute and add a