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