1;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2;; balance-forecast.scm
3;; Simulate future balance based on scheduled transactions.
4;;
5;; By Ryan Turner 2019-02-27 <zdbiohazard2@gmail.com>
6;;
7;; This program is free software; you can redistribute it and/or
8;; modify it under the terms of the GNU General Public License as
9;; published by the Free Software Foundation; either version 2 of
10;; the License, or (at your option) any later version.
11;;
12;; This program is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15;; GNU General Public License for more details.
16;;
17;; You should have received a copy of the GNU General Public License
18;; along with this program; if not, contact:
19;;
20;; Free Software Foundation           Voice:  +1-617-542-5942
21;; 51 Franklin Street, Fifth Floor    Fax:    +1-617-542-2652
22;; Boston, MA  02110-1301,  USA       gnu@gnu.org
23;;
24;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25
26(define-module (gnucash reports standard balance-forecast))
27
28(use-modules (gnucash engine))
29(use-modules (gnucash core-utils))
30(use-modules (gnucash app-utils))
31(use-modules (gnucash report))
32(use-modules (srfi srfi-1))
33
34; Name definitions
35(define reportname           (N_ "Balance Forecast"))
36
37(define optname-accounts     (N_ "Accounts"))
38(define opthelp-accounts     (G_ "Report on these accounts."))
39
40(define optname-from-date    (N_ "Start Date"))
41(define optname-to-date      (N_ "End Date"))
42(define optname-interval     (N_ "Interval"))
43
44(define optname-currency     (N_ "Report's currency"))
45(define optname-price        (N_ "Price Source"))
46
47(define optname-plot-width   (N_ "Plot Width"))
48(define optname-plot-height  (N_ "Plot Height"))
49(define optname-show-markers (N_ "Data markers?"))
50(define opthelp-show-markers (G_ "Display a mark for each data point."))
51
52(define optname-show-reserve (N_ "Show reserve line"))
53(define opthelp-show-reserve (G_ "Show reserve line"))
54
55(define optname-reserve      (N_ "Reserve amount"))
56(define opthelp-reserve      (G_ "The reserve amount is set to a \
57minimum balance desired"))
58
59(define optname-show-target  (N_ "Show target line"))
60(define opthelp-show-target  (G_ "Show target line"))
61
62(define optname-target       (N_ "Target amount above reserve"))
63(define opthelp-target       (G_ "The target is used to plan for \
64a future large purchase, which will be added as a line above the \
65reserve amount."))
66
67(define optname-show-minimum (N_ "Show future minimum"))
68(define opthelp-show-minimum (G_ "The future minimum will add, for each \
69date point, a projected minimum balance including scheduled transactions."))
70
71; Options generator
72(define (options-generator)
73  (let* ((options (gnc:new-options)))
74    ; Account selector
75    (gnc:register-option options
76      (gnc:make-account-list-option
77        gnc:pagename-accounts optname-accounts "a" opthelp-accounts
78        (lambda ()
79          (gnc:filter-accountlist-type
80            (list ACCT-TYPE-BANK ACCT-TYPE-CASH)
81            (gnc-account-get-descendants-sorted
82              (gnc-get-current-root-account))))
83        #f #t))
84
85    ; Date range
86    (gnc:options-add-date-interval! options
87      gnc:pagename-general optname-from-date optname-to-date "a")
88    ; Date interval
89    (gnc:options-add-interval-choice! options
90      gnc:pagename-general optname-interval "b" 'DayDelta)
91    ; Report currency
92    (gnc:options-add-currency! options
93      gnc:pagename-general optname-currency "c")
94    ; Price source
95    (gnc:options-add-price-source! options
96      gnc:pagename-general optname-price "d" 'pricedb-nearest)
97
98    ; Plot size
99    (gnc:options-add-plot-size! options gnc:pagename-display
100      optname-plot-width optname-plot-height "a"
101      (cons 'percent 100.0) (cons 'percent 100.0))
102    ; Markers
103    (gnc:register-option options (gnc:make-simple-boolean-option
104      gnc:pagename-display optname-show-markers "b" opthelp-show-markers #f))
105    ; Reserve line
106    (gnc:register-option options (gnc:make-complex-boolean-option
107      gnc:pagename-display optname-show-reserve "c" opthelp-show-reserve #f #f
108      (lambda (x)
109        (gnc-option-db-set-option-selectable-by-name
110         options gnc:pagename-display optname-reserve x))))
111    (gnc:register-option options (gnc:make-number-range-option
112      gnc:pagename-display optname-reserve "d" opthelp-reserve
113      0 -10E9 10E9 2 0.01))
114    ; Purchasing power target
115    (gnc:register-option options (gnc:make-complex-boolean-option
116      gnc:pagename-display optname-show-target "e" opthelp-show-target #f #f
117      (lambda (x)
118        (gnc-option-db-set-option-selectable-by-name
119         options gnc:pagename-display optname-target x))))
120    (gnc:register-option options (gnc:make-number-range-option
121      gnc:pagename-display optname-target "f" opthelp-target
122      0 -10E9 10E9 2 0.01))
123    ; Future minimum
124    (gnc:register-option options (gnc:make-simple-boolean-option
125      gnc:pagename-display optname-show-minimum "g" opthelp-show-minimum #f))
126    (gnc:options-set-default-section options gnc:pagename-general)
127    options)
128)
129
130; Renderer
131(define (document-renderer report-obj)
132  ; Option-getting helper function.
133  (define (get-option pagename optname)
134    (gnc:option-value
135      (gnc:lookup-option (gnc:report-options report-obj) pagename optname)))
136  (define report-title
137    (get-option gnc:pagename-general gnc:optname-reportname))
138
139  (gnc:report-starting report-title)
140
141  (let* ( (document (gnc:make-html-document))
142          ; Options
143          (accounts (get-option gnc:pagename-accounts optname-accounts))
144
145          (from-date (gnc:time64-start-day-time (gnc:date-option-absolute-time
146            (get-option gnc:pagename-general optname-from-date))))
147          (to-date (gnc:time64-end-day-time (gnc:date-option-absolute-time
148            (get-option gnc:pagename-general optname-to-date))))
149          (interval (get-option gnc:pagename-general optname-interval))
150          (currency (get-option gnc:pagename-general optname-currency))
151          (price (get-option gnc:pagename-general optname-price))
152
153          (plot-width (get-option gnc:pagename-display optname-plot-width))
154          (plot-height (get-option gnc:pagename-display optname-plot-height))
155          (markers (if (get-option gnc:pagename-display optname-show-markers)
156                       3 0))
157          (show-reserve (get-option gnc:pagename-display optname-show-reserve))
158          (reserve (get-option gnc:pagename-display optname-reserve))
159          (show-target (get-option gnc:pagename-display optname-show-target))
160          (target (get-option gnc:pagename-display optname-target))
161          (show-minimum (get-option gnc:pagename-display optname-show-minimum))
162
163          ; Variables
164          (chart (gnc:make-html-chart))
165          (intervals (gnc:make-date-interval-list
166            from-date to-date (gnc:deltasym-to-delta interval)))
167          (accum (gnc:make-commodity-collector))
168          (exchange-fn (gnc:case-exchange-time-fn
169                        price currency
170                        (gnc:accounts-get-commodities accounts #f)
171                        to-date #f #f))
172          (iso-date (qof-date-format-get-string QOF-DATE-FORMAT-ISO))
173          (accounts-balancelist
174           (map
175            (lambda (acc)
176              (gnc:account-get-balances-at-dates acc (map cadr intervals)))
177            accounts)))
178
179    (cond
180     ((null? accounts)
181      (gnc:html-document-add-object!
182       document
183       (gnc:html-make-no-account-warning
184        report-title (gnc:report-id report-obj))))
185
186     ((every zero? (map gnc:gnc-monetary-amount (apply append accounts-balancelist)))
187      (gnc:html-document-add-object!
188       document
189       (gnc:html-make-empty-data-warning
190        report-title (gnc:report-id report-obj))))
191
192     (else
193      ;; initialize the SX balance accumulator with the instantiated SX
194      ;; amounts starting from the earliest split date in the list of
195      ;; accounts up to the report start date.
196      (let* ((accounts-dates (map (compose xaccTransGetDate xaccSplitGetParent car)
197                                  (filter pair?
198                                          (map xaccAccountGetSplitList accounts))))
199             (earliest (and (pair? accounts-dates) (apply min accounts-dates)))
200             (sx-hash (if earliest
201                          (gnc-sx-all-instantiate-cashflow-all earliest from-date)
202                          (make-hash-table))))
203        (for-each
204         (lambda (account)
205           (accum 'add (xaccAccountGetCommodity account)
206                  (hash-ref sx-hash (gncAccountGetGUID account) 0)))
207         accounts))
208
209      ;; Calculate balances
210      (let ((balances
211             (map
212              (lambda (date accounts-balance)
213                (let* ((start-date (car date))
214                       (end-date (cadr date))
215                       (balance (gnc:make-commodity-collector))
216                       (sx-value (gnc-sx-all-instantiate-cashflow-all
217                                  start-date end-date)))
218                  (for-each
219                   (lambda (account account-balance)
220                     (accum 'add (xaccAccountGetCommodity account)
221                            (hash-ref sx-value (gncAccountGetGUID account) 0))
222                     (balance 'add (gnc:gnc-monetary-commodity account-balance)
223                              (gnc:gnc-monetary-amount account-balance)))
224                   accounts accounts-balance)
225                  (balance 'merge accum #f)
226                  (gnc:gnc-monetary-amount
227                   (gnc:sum-collector-commodity
228                    balance currency
229                    (lambda (monetary target-curr)
230                      (exchange-fn monetary target-curr end-date))))))
231              intervals (apply zip accounts-balancelist))))
232
233        ;; Minimum line
234        (when show-minimum
235          (gnc:html-chart-add-data-series!
236           chart
237           (G_ "Minimum")
238           (let loop ((balances balances) (result '()))
239                   (if (null? balances) (reverse! result)
240                       (loop (cdr balances) (cons (apply min balances) result))))
241           "#0AA"
242           'fill #f
243           'borderWidth 1.5
244           'pointRadius markers))
245
246        ;; Balance line (do this here so it draws over the minimum line)
247        (gnc:html-chart-add-data-series!
248         chart (G_ "Balance") balances "#0A0"
249         'fill #f
250         'borderWidth 1.5
251         'pointRadius markers)
252
253        ;; Target line
254        (when show-target
255          (gnc:html-chart-add-data-series!
256           chart (G_ "Target")
257           (make-list (length intervals) (+ reserve target))
258           "#FF0"
259           'fill #f
260           'borderWidth 1.5
261           'pointRadius markers))
262
263        ;; Reserve line
264        (when show-reserve
265          (gnc:html-chart-add-data-series!
266           chart (G_ "Reserve") (make-list (length intervals) reserve)
267           "#F00"
268           'fill #f
269           'borderWidth 1.5
270           'pointRadius markers))
271
272        (gnc:html-chart-set-type! chart 'line)
273        ;; Set the chart titles
274        (gnc:html-chart-set-title!
275         chart (list report-title
276                     (format #f (G_ "~a to ~a")
277                       (qof-print-date from-date) (qof-print-date to-date))))
278        ;; Set the chart size
279        (gnc:html-chart-set-width! chart plot-width)
280        (gnc:html-chart-set-height! chart plot-height)
281        ;; Set the axis labels
282        (gnc:html-chart-set-y-axis-label!
283         chart (gnc-commodity-get-mnemonic currency))
284        ;; Set series labels
285        (gnc:html-chart-set-data-labels!
286         chart (map (lambda (data)
287                      (gnc-print-time64 (cadr data) iso-date))
288                    intervals))
289
290        ;; Set currency symbol
291        (gnc:html-chart-set-currency-iso!
292        chart (gnc-commodity-get-mnemonic currency))
293        (gnc:html-chart-set-currency-symbol!
294         chart (gnc-commodity-get-nice-symbol currency))
295
296        ;; Allow tooltip in whole chartarea
297        (gnc:html-chart-set! chart '(options tooltips mode) "index")
298        (gnc:html-chart-set! chart '(options tooltips intersect) #f)
299
300        ;; We're done!
301        (gnc:html-document-add-object! document chart)
302        (gnc:report-finished))))
303    document))
304
305(gnc:define-report
306  'version 1
307  'name reportname
308  'report-guid "321d940d487d4ccbb4bd0467ffbadbf2"
309  'menu-path (list gnc:menuname-asset-liability)
310  'options-generator options-generator
311  'renderer document-renderer)
312