1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2
;; daily-reports.scm: reports based on the day of the week
4
;; Copyright (C) 2003, Andy Wingo <wingo at pobox dot com>
6
;; based on account-piecharts.scm by Robert Merkel (rgmerk@mira.net)
7
;; and Christian Stimming <stimming@tu-harburg.de> with
8
;; analyze-splits from average-balance.scm
10
;; This program is free software; you can redistribute it and/or
11
;; modify it under the terms of the GNU General Public License as
12
;; published by the Free Software Foundation; either version 2 of
13
;; the License, or (at your option) any later version.
15
;; This program is distributed in the hope that it will be useful,
16
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18
;; GNU General Public License for more details.
20
;; You should have received a copy of the GNU General Public License
21
;; along with this program; if not, contact:
23
;; Free Software Foundation Voice: +1-617-542-5942
24
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
25
;; Boston, MA 02110-1301, USA gnu@gnu.org
27
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29
(define-module (gnucash report daily-reports))
31
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
32
(use-modules (srfi srfi-1))
33
(use-modules (ice-9 slib))
34
(use-modules (ice-9 regex))
35
(use-modules (gnucash gnc-module))
39
(gnc:module-load "gnucash/report/report-system" 0)
41
(define menuname-income (N_ "Income vs. Day of Week"))
42
(define menuname-expense (N_ "Expenses vs. Day of Week"))
44
;; The menu statusbar tips.
45
(define menutip-income
46
(N_ "Shows a piechart with the total income for each day of the week"))
47
(define menutip-expense
48
(N_ "Shows a piechart with the total expenses for each day of the week"))
50
;; The names here are used 1. for internal identification, 2. as
51
;; tab labels, 3. as default for the 'Report name' option which
52
;; in turn is used for the printed report title.
53
(define reportname-income (N_ "Income vs. Day of Week"))
54
(define reportname-expense (N_ "Expenses vs. Day of Week"))
56
(define optname-from-date (N_ "From"))
57
(define optname-to-date (N_ "To"))
58
(define optname-report-currency (N_ "Report's currency"))
59
(define optname-price-source (N_ "Price Source"))
61
(define optname-accounts (N_ "Accounts"))
62
(define optname-levels (N_ "Show Accounts until level"))
63
(define optname-subacct (N_ "Include Sub-Accounts"))
65
(define optname-fullname (N_ "Show long account names"))
66
(define optname-show-total (N_ "Show Totals"))
67
(define optname-slices (N_ "Maximum Slices"))
68
(define optname-plot-width (N_ "Plot Width"))
69
(define optname-plot-height (N_ "Plot Height"))
70
(define optname-sort-method (N_ "Sort Method"))
72
;; The option-generator. The only dependance on the type of piechart
73
;; is the list of account types that the account selection option
75
(define (options-generator account-types)
76
(let* ((options (gnc:new-options))
79
(gnc:register-option options new-option))))
81
(gnc:options-add-date-interval!
82
options gnc:pagename-general
83
optname-from-date optname-to-date "a")
85
(gnc:options-add-currency!
86
options gnc:pagename-general optname-report-currency "b")
88
(gnc:options-add-price-source!
89
options gnc:pagename-general
90
optname-price-source "c" 'weighted-average)
93
(gnc:make-simple-boolean-option
94
gnc:pagename-accounts optname-subacct
95
"a" (N_ "Include sub-accounts of all selected accounts") #t))
98
(gnc:make-account-list-option
99
gnc:pagename-accounts optname-accounts
101
(N_ "Report on these accounts, if chosen account level allows.")
103
(gnc:filter-accountlist-type
105
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
108
(gnc:filter-accountlist-type
113
(gnc:options-add-account-levels!
114
options gnc:pagename-accounts optname-levels "b"
115
(N_ "Show accounts to this depth and not further")
119
(gnc:make-simple-boolean-option
120
gnc:pagename-display optname-show-total
121
"b" (N_ "Show the total balance in legend?") #t))
123
(gnc:options-add-plot-size!
124
options gnc:pagename-display
125
optname-plot-width optname-plot-height "d" 500 500)
127
(gnc:options-set-default-section options gnc:pagename-general)
132
; from average-balance.scm
134
;; analyze-splits crunches a split list into a set of period
135
;; summaries. Each summary is a list of (start-date end-date
136
;; avg-bal max-bal min-bal total-in total-out net) if multiple
137
;; accounts are selected the balance is the sum for all. Each
138
;; balance in a foreign currency will be converted to a double in
139
;; the report-currency by means of the monetary->double
141
(define (analyze-splits splits start-bal-double
142
start-date end-date interval monetary->double)
144
(gnc:make-date-interval-list start-date end-date interval))
147
(define (output-row interval-start
156
(/ (stats-accum 'total #f)
157
(gnc:timepair-delta interval-start
159
(minmax-accum 'getmax #f)
160
(minmax-accum 'getmin #f)
161
(gain-loss-accum 'debits #f)
162
(gain-loss-accum 'credits #f)
163
(- (gain-loss-accum 'debits #f)
164
(gain-loss-accum 'credits #f)))
167
;; Returns a double which is the split value, correctly
168
;; exchanged to the current report-currency. We use the exchange
169
;; rate at the 'date'.
170
(define (get-split-value split date)
172
(gnc:make-gnc-monetary
173
(xaccAccountGetCommodity (xaccSplitGetAccount split))
174
(xaccSplitGetAmount split))
177
;; calculate the statistics for one interval - returns a list
178
;; containing the following:
179
;; min-max acculumator
180
;; average-accumulator
181
;; gain-loss accumulator
182
;; final balance for this interval
183
;; splits remaining to be processed.
185
;; note that it is assumed that every split in in the list
186
;; has a date >= from
188
(define (process-interval splits from to start-balance)
190
(let ((minmax-accum (gnc:make-stats-collector))
191
(stats-accum (gnc:make-stats-collector))
192
(gain-loss-accum (gnc:make-drcr-collector))
193
(last-balance start-balance)
194
(last-balance-time from))
197
(define (update-stats split-amt split-time)
198
(let ((time-difference (gnc:timepair-delta
201
(stats-accum 'add (* last-balance time-difference))
202
(set! last-balance (+ last-balance split-amt))
203
(set! last-balance-time split-time)
204
(minmax-accum 'add last-balance)
205
(gain-loss-accum 'add split-amt)))
207
(define (split-recurse)
208
(if (or (null? splits) (gnc:timepair-gt
209
(gnc-transaction-get-date-posted
214
((split (car splits))
215
(split-time (gnc-transaction-get-date-posted
216
(xaccSplitGetParent split)))
217
;; FIXME: Which date should we use here? The 'to'
218
;; date? the 'split-time'?
219
(split-amt (get-split-value split split-time)))
222
; (gnc:debug "split " split)
223
; (gnc:debug "split-time " split-time)
224
; (gnc:debug "split-amt " split-amt)
225
; (gnc:debug "splits " splits)
226
(update-stats split-amt split-time)
227
(set! splits (cdr splits))
230
; the minmax accumulator
232
(minmax-accum 'add start-balance)
234
(if (not (null? splits))
237
;; insert a null transaction at the end of the interval
238
(update-stats 0.0 to)
239
(list minmax-accum stats-accum gain-loss-accum last-balance splits)))
252
(min-max-accum (car interval-results))
253
(stats-accum (cadr interval-results))
254
(gain-loss-accum (caddr interval-results))
255
(last-bal (cadddr interval-results))
256
(rest-splits (list-ref interval-results 4)))
258
(set! start-bal-double last-bal)
259
(set! splits rest-splits)
260
(output-row (car interval)
263
min-max-accum gain-loss-accum)))
267
(reverse data-rows)))
270
;; The rendering function. Since it works for a bunch of different
271
;; account settings, you have to give the reportname, the
272
;; account-types to work on and whether this report works on
273
;; intervals as arguments.
274
(define (piechart-renderer report-obj reportname
277
;; This is a helper function for looking up option values.
278
(define (get-option section name)
281
(gnc:report-options report-obj) section name)))
283
(gnc:report-starting reportname)
286
(let* ((to-date-tp (gnc:timepair-end-day-time
287
(gnc:date-option-absolute-time
288
(get-option gnc:pagename-general optname-to-date))))
289
(from-date-tp (gnc:timepair-start-day-time
290
(gnc:date-option-absolute-time
291
(get-option gnc:pagename-general
292
optname-from-date))))
293
(accounts (get-option gnc:pagename-accounts optname-accounts))
294
(dosubs? (get-option gnc:pagename-accounts optname-subacct))
295
(account-levels (get-option gnc:pagename-accounts optname-levels))
296
(report-currency (get-option gnc:pagename-general
297
optname-report-currency))
298
(price-source (get-option gnc:pagename-general
299
optname-price-source))
300
(report-title (get-option gnc:pagename-general
301
gnc:optname-reportname))
303
(show-total? (get-option gnc:pagename-display optname-show-total))
304
(height (get-option gnc:pagename-display optname-plot-height))
305
(width (get-option gnc:pagename-display optname-plot-width))
309
(print-info (gnc-commodity-print-info report-currency #t))
311
(beforebegindate (gnc:timepair-end-day-time
312
(gnc:timepair-previous-day from-date-tp)))
313
(document (gnc:make-html-document))
314
(chart (gnc:make-html-piechart))
315
(topl-accounts (gnc:filter-accountlist-type
317
(gnc-account-get-children-sorted
318
(gnc-get-current-root-account)))))
320
(define (monetary->double foreign-monetary date)
321
(gnc-numeric-to-double
322
(gnc:gnc-monetary-amount
323
(exchange-fn foreign-monetary report-currency date))))
325
;; FIXME: why does this need to be re-defined here?
327
(if (or (null? args) (member #t (map null? args)))
329
(append (list (map car args))
330
(apply zip (map cdr args)))))
332
;; FIXME: why does this need to be re-defined here?
333
(define (filter proc l)
337
(cons (car l) (filter proc (cdr l)))
338
(filter proc (cdr l)))))
340
(if (not (null? accounts))
341
(let* ((query (qof-query-create-for-splits))
344
;; startbal will be a commodity-collector
346
(daily-totals (list 0 0 0 0 0 0 0))
347
;; Note: the absolute-super-duper-i18n'ed solution
348
;; would be to use the locale-using functions
349
;; date->string of srfi-19, similar to get_wday_name()
350
;; in src/engine/FreqSpeq.c. For now, we simply use
351
;; the normal translations, which show up in the glade
352
;; file src/gnome/glade/sched-xact.glade anyway.
353
(days-of-week (list (_"Sunday") (_"Monday")
354
(_"Tuesday") (_"Wednesday")
355
(_"Thursday") (_"Friday") (_"Saturday"))))
357
(gnc:debug daily-totals)
359
;; The percentage done numbers here are a hack so that
360
;; something gets displayed. On my system the
361
;; gnc:case-exchange-time-fn takes about 20% of the time
362
;; building up a list of prices for later use. Either this
363
;; routine needs to send progress reports, or the price
364
;; lookup should be distributed and done when actually
365
;; needed so as to amortize the cpu time properly.
366
(gnc:report-percent-done 1)
367
(set! commodity-list (gnc:accounts-get-commodities
369
(gnc:acccounts-get-all-subaccounts accounts)
372
(gnc:report-percent-done 5)
373
(set! exchange-fn (gnc:case-exchange-time-fn
374
price-source report-currency
375
commodity-list to-date-tp
377
(gnc:report-percent-done 20)
379
;; initialize the query to find splits in the right
380
;; date range and accounts
381
(qof-query-set-book query (gnc-get-current-book))
383
;; for balance purposes, we don't need to do this, but it cleans up
384
;; the table display.
385
(gnc:query-set-match-non-voids-only! query (gnc-get-current-book))
386
;; add accounts to the query (include subaccounts
388
(gnc:report-percent-done 25)
390
(let ((subaccts '()))
393
(let ((this-acct-subs
394
(gnc-account-get-descendants-sorted acct)))
395
(if (list? this-acct-subs)
397
(append subaccts this-acct-subs)))))
399
;; Beware: delete-duplicates is an O(n^2)
400
;; algorithm. More efficient method: sort the list,
401
;; then use a linear algorithm.
403
(delete-duplicates (append accounts subaccts)))))
404
(gnc:report-percent-done 30)
406
(xaccQueryAddAccountMatch query accounts QOF-GUID-MATCH-ANY QOF-QUERY-AND)
408
;; match splits between start and end dates
409
(xaccQueryAddDateMatchTS
410
query #t from-date-tp #t to-date-tp QOF-QUERY-AND)
411
(qof-query-set-sort-order query
412
(list SPLIT-TRANS TRANS-DATE-POSTED)
413
(list QUERY-DEFAULT-SORT)
416
;; get the query results
417
(set! splits (qof-query-run query))
418
(gnc:report-percent-done 40)
420
;; find the net starting balance for the set of accounts
422
(gnc:accounts-get-balance-helper
424
(lambda (acct) (gnc:account-get-comm-balance-at-date
425
acct beforebegindate #f))
426
gnc-reverse-balance))
427
(gnc:report-percent-done 50)
430
(gnc-numeric-to-double
431
(gnc:gnc-monetary-amount
432
(gnc:sum-collector-commodity
436
(exchange-fn a b beforebegindate))))))
437
(gnc:report-percent-done 60)
439
;; and analyze the data
440
(set! data (analyze-splits splits startbal
441
from-date-tp to-date-tp
442
DayDelta monetary->double))
443
(gnc:report-percent-done 70)
445
;; now, in data we have a list of (start-date end-date avg-bal
446
;; max-bal min-bal total-in total-out net). what we really
447
;; want is just the last element, #7.
451
(let ((k (modulo (- (gnc:timepair-get-week-day
452
(list-ref split 1)) 1) 7))) ; end-date
453
(list-set! daily-totals k
454
(+ (list-ref daily-totals k)
455
(list-ref split 7))))) ; net
458
(let* ((zipped-list (filter (lambda (p)
459
(not (zero? (cadr p)))) (zip days-of-week
461
(labels (map (lambda (p)
467
(double-to-gnc-numeric
469
(gnc-commodity-get-fraction report-currency)
475
(if (not (null? zipped-list))
477
(gnc:html-piechart-set-title! chart report-title)
478
(gnc:html-piechart-set-width! chart width)
479
(gnc:html-piechart-set-height! chart height)
481
(gnc:html-piechart-set-subtitle!
485
(gnc-print-date from-date-tp)
486
(gnc-print-date to-date-tp))
488
(let ((total (apply + daily-totals)))
492
(double-to-gnc-numeric
494
(gnc-commodity-get-fraction report-currency)
499
(gnc:html-piechart-set-data! chart (map cadr zipped-list))
500
(gnc:html-piechart-set-colors!
501
chart (gnc:assign-colors (length zipped-list)))
502
(gnc:html-piechart-set-labels! chart labels)
504
(gnc:html-document-add-object! document chart))
505
(gnc:html-document-add-object!
507
(gnc:html-make-empty-data-warning
508
report-title (gnc:report-id report-obj))))))
510
(gnc:html-document-add-object!
512
(gnc:html-make-empty-data-warning
513
report-title (gnc:report-id report-obj))))
515
(gnc:report-finished)
523
'menu-path (list gnc:menuname-income-expense)
525
'menu-tip (car (cdddr l))
526
'options-generator (lambda () (options-generator (cadr l)))
527
'renderer (lambda (report-obj)
528
(piechart-renderer report-obj
533
;; reportname, account-types, menu-reportname, menu-tip
534
(list reportname-income (list ACCT-TYPE-INCOME) menuname-income menutip-income)
535
(list reportname-expense (list ACCT-TYPE-EXPENSE) menuname-expense menutip-expense)))
added
removed
src/report/standard-reports/daily-reports.scm
