IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

2003-03-29 Christian Stimming <stimming@tuhh.de>

Browse Source 
* src/report/standard-reports/daily-reports.scm: New report
	"income vs. day of week" by Andy Wingo <wingo@pobox.com>.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@8107 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Christian Stimming 2003-03-29 22:21:24 +00:00
parent 5278b8e655
commit 18c67f9db8
4 changed files with 540 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
AUTHORS
View File

@ -203,6 +203,7 @@ Richard -Gilligan- Uschold <uschold@cs.ucf.edu> tax report & txf export
Matthew Vanecek <mevanecek@yahoo.com> for pg_config configure.in patch
Richard Wackerbarth <rkw@dataplex.net> patch to gnc-prices, qif import fixes
Rob Walker <rob@valinux.com> guile and register patches
Andy Wingo <wingo@pobox.com> income per day-of-week report
David Woodhouse <dwmw2@infradead.org> messages British translations
Ken Yamaguchi <gooch@ic.EECS.Berkeley.EDU> QIF import fixes; MYM import
Shimpei Yamashita <shimpei@gol.com> messages Japanese translation

3
ChangeLog
View File

@ -1,5 +1,8 @@
2003-03-29 Christian Stimming <stimming@tuhh.de>
* src/report/standard-reports/daily-reports.scm: New report
"income vs. day of week" by Andy Wingo <wingo@pobox.com>.
* src/engine/gnc-session.c: OpenBSD fix by Todd T. Fries
<todd@flare.fries.net>

535
src/report/standard-reports/daily-reports.scm Normal file
View File

@ -0,0 +1,535 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; daily-reports.scm: reports based on the day of the week
;;
;; Copyright (C) 2003, Andy Wingo <wingo at pobox dot com>
;;
;; based on account-piecharts.scm by Robert Merkel (rgmerk@mira.net)
;; and Christian Stimming <stimming@tu-harburg.de> with
;; analyze-splits from average-balance.scm
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
;; Boston, MA 02111-1307, USA gnu@gnu.org
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report daily-reports))
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (srfi srfi-1))
(use-modules (ice-9 slib))
(use-modules (ice-9 regex))
(use-modules (gnucash gnc-module))
(require 'printf)
(gnc:module-load "gnucash/report/report-system" 0)
(define menuname-income (N_ "Income vs. Day of Week"))
(define menuname-expense (N_ "Expenses vs. Day of Week"))
;; The menu statusbar tips.
(define menutip-income
(N_ "Shows a piechart with the total income for each day of the week"))
(define menutip-expense
(N_ "Shows a piechart with the total expenses for each day of the week"))
;; The names here are used 1. for internal identification, 2. as
;; tab labels, 3. as default for the 'Report name' option which
;; in turn is used for the printed report title.
(define reportname-income (N_ "Income vs. Day of Week"))
(define reportname-expense (N_ "Expenses vs. Day of Week"))
(define optname-from-date (N_ "From"))
(define optname-to-date (N_ "To"))
(define optname-report-currency (N_ "Report's currency"))
(define optname-price-source (N_ "Price Source"))
(define optname-accounts (N_ "Accounts"))
(define optname-levels (N_ "Show Accounts until level"))
(define optname-subacct (N_ "Include Sub-Accounts"))
(define optname-fullname (N_ "Show long account names"))
(define optname-show-total (N_ "Show Totals"))
(define optname-slices (N_ "Maximum Slices"))
(define optname-plot-width (N_ "Plot Width"))
(define optname-plot-height (N_ "Plot Height"))
(define optname-sort-method (N_ "Sort Method"))
;; The option-generator. The only dependance on the type of piechart
;; is the list of account types that the account selection option
;; accepts.
(define (options-generator account-types)
(let* ((options (gnc:new-options))
(add-option
(lambda (new-option)
(gnc:register-option options new-option))))
(gnc:options-add-date-interval!
options gnc:pagename-general
optname-from-date optname-to-date "a")
(gnc:options-add-currency!
options gnc:pagename-general optname-report-currency "b")
(gnc:options-add-price-source!
options gnc:pagename-general
optname-price-source "c" 'weighted-average)
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-accounts optname-subacct
"a" (N_ "Include sub-accounts of all selected accounts") #t))
(add-option
(gnc:make-account-list-option
gnc:pagename-accounts optname-accounts
"a"
(N_ "Report on these accounts, if chosen account level allows.")
(lambda ()
(gnc:filter-accountlist-type
account-types
(gnc:group-get-subaccounts (gnc:get-current-group))))
(lambda (accounts)
(list #t
(gnc:filter-accountlist-type
account-types
accounts)))
#t))
(gnc:options-add-account-levels!
options gnc:pagename-accounts optname-levels "b"
(N_ "Show accounts to this depth and not further")
2)
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-total
"b" (N_ "Show the total balance in legend?") #t))
(gnc:options-add-plot-size!
options gnc:pagename-display
optname-plot-width optname-plot-height "d" 500 500)
(gnc:options-set-default-section options gnc:pagename-general)
options))
; from average-balance.scm
;; analyze-splits crunches a split list into a set of period
;; summaries. Each summary is a list of (start-date end-date
;; avg-bal max-bal min-bal total-in total-out net) if multiple
;; accounts are selected the balance is the sum for all. Each
;; balance in a foreign currency will be converted to a double in
;; the report-currency by means of the monetary->double
;; function.
(define (analyze-splits splits start-bal-double
start-date end-date interval monetary->double)
(let ((interval-list
(gnc:make-date-interval-list start-date end-date interval))
(data-rows '()))
(define (output-row interval-start
interval-end
stats-accum
minmax-accum
gain-loss-accum)
(set! data-rows
(cons
(list interval-start
interval-end
(/ (stats-accum 'total #f)
(gnc:timepair-delta interval-start
interval-end))
(minmax-accum 'getmax #f)
(minmax-accum 'getmin #f)
(gain-loss-accum 'debits #f)
(gain-loss-accum 'credits #f)
(- (gain-loss-accum 'debits #f)
(gain-loss-accum 'credits #f)))
data-rows)))
;; Returns a double which is the split value, correctly
;; exchanged to the current report-currency. We use the exchange
;; rate at the 'date'.
(define (get-split-value split date)
(monetary->double
(gnc:make-gnc-monetary
(gnc:account-get-commodity (gnc:split-get-account split))
(gnc:split-get-amount split))
date))
;; calculate the statistics for one interval - returns a list
;; containing the following:
;; min-max acculumator
;; average-accumulator
;; gain-loss accumulator
;; final balance for this interval
;; splits remaining to be processed.
;; note that it is assumed that every split in in the list
;; has a date >= from
(define (process-interval splits from to start-balance)
(let ((minmax-accum (gnc:make-stats-collector))
(stats-accum (gnc:make-stats-collector))
(gain-loss-accum (gnc:make-drcr-collector))
(last-balance start-balance)
(last-balance-time from))
(define (update-stats split-amt split-time)
(let ((time-difference (gnc:timepair-delta
last-balance-time
split-time)))
(stats-accum 'add (* last-balance time-difference))
(set! last-balance (+ last-balance split-amt))
(set! last-balance-time split-time)
(minmax-accum 'add last-balance)
(gain-loss-accum 'add split-amt)))
(define (split-recurse)
(if (or (null? splits) (gnc:timepair-gt
(gnc:transaction-get-date-posted
(gnc:split-get-parent
(car splits))) to))
#f
(let*
((split (car splits))
(split-time (gnc:transaction-get-date-posted
(gnc:split-get-parent split)))
;; FIXME: Which date should we use here? The 'to'
;; date? the 'split-time'?
(split-amt (get-split-value split split-time)))
; (gnc:debug "split " split)
; (gnc:debug "split-time " split-time)
; (gnc:debug "split-amt " split-amt)
; (gnc:debug "splits " splits)
(update-stats split-amt split-time)
(set! splits (cdr splits))
(split-recurse))))
; the minmax accumulator
(minmax-accum 'add start-balance)
(if (not (null? splits))
(split-recurse))
;; insert a null transaction at the end of the interval
(update-stats 0.0 to)
(list minmax-accum stats-accum gain-loss-accum last-balance splits)))
(for-each
(lambda (interval)
(let*
((interval-results
(process-interval
splits
(car interval)
(cadr interval)
start-bal-double))
(min-max-accum (car interval-results))
(stats-accum (cadr interval-results))
(gain-loss-accum (caddr interval-results))
(last-bal (cadddr interval-results))
(rest-splits (list-ref interval-results 4)))
(set! start-bal-double last-bal)
(set! splits rest-splits)
(output-row (car interval)
(cadr interval)
stats-accum
min-max-accum gain-loss-accum)))
interval-list)
(reverse data-rows)))
;; The rendering function. Since it works for a bunch of different
;; account settings, you have to give the reportname, the
;; account-types to work on and whether this report works on
;; intervals as arguments.
(define (piechart-renderer report-obj reportname
account-types)
;; This is a helper function for looking up option values.
(define (get-option section name)
(gnc:option-value
(gnc:lookup-option
(gnc:report-options report-obj) section name)))
(gnc:report-starting reportname)
;; Get all options
(let* ((to-date-tp (gnc:timepair-end-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general optname-to-date))))
(from-date-tp (gnc:timepair-start-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general
optname-from-date))))
(accounts (get-option gnc:pagename-accounts optname-accounts))
(dosubs? (get-option gnc:pagename-accounts optname-subacct))
(account-levels (get-option gnc:pagename-accounts optname-levels))
(report-currency (get-option gnc:pagename-general
optname-report-currency))
(price-source (get-option gnc:pagename-general
optname-price-source))
(report-title (get-option gnc:pagename-general
gnc:optname-reportname))
(show-total? (get-option gnc:pagename-display optname-show-total))
(height (get-option gnc:pagename-display optname-plot-height))
(width (get-option gnc:pagename-display optname-plot-width))
(commodity-list #f)
(exchange-fn #f)
(print-info (gnc:commodity-print-info report-currency #t))
(beforebegindate (gnc:timepair-end-day-time
(gnc:timepair-previous-day from-date-tp)))
(document (gnc:make-html-document))
(chart (gnc:make-html-piechart))
(topl-accounts (gnc:filter-accountlist-type
account-types
(gnc:group-get-account-list
(gnc:get-current-group)))))
(define (monetary->double foreign-monetary date)
(gnc:numeric-to-double
(gnc:gnc-monetary-amount
(exchange-fn foreign-monetary report-currency date))))
;; FIXME: why does this need to be re-defined here?
(define (zip . args)
(if (or (null? args) (member #t (map null? args)))
'()
(append (list (map car args))
(apply zip (map cdr args)))))
;; FIXME: why does this need to be re-defined here?
(define (filter proc l)
(if (null? l)
'()
(if (proc (car l))
(cons (car l) (filter proc (cdr l)))
(filter proc (cdr l)))))
(if (not (null? accounts))
(let* ((query (gnc:malloc-query))
(splits '())
(data '())
;; startbal will be a commodity-collector
(startbal '())
(daily-totals (list 0 0 0 0 0 0 0))
;; Note: the absolute-super-duper-i18n'ed solution
;; would be to use the locale-using functions
;; date->string of srfi-19, similar to get_wday_name()
;; in src/engine/FreqSpeq.c. For now, we simply use
;; the normal translations, which show up in the glade
;; file src/gnome/glade/sched-xact.glade anyway.
(days-of-week (list (_"Sunday") (_"Monday")
(_"Tuesday") (_"Wednesday")
(_"Thursday") (_"Friday") (_"Saturday"))))
(gnc:debug daily-totals)
;; The percentage done numbers here are a hack so that
;; something gets displayed. On my system the
;; gnc:case-exchange-time-fn takes about 20% of the time
;; building up a list of prices for later use. Either this
;; routine needs to send progress reports, or the price
;; lookup should be distributed and done when actually
;; needed so as to amortize the cpu time properly.
(gnc:report-percent-done 1)
(set! commodity-list (gnc:accounts-get-commodities
(append
(gnc:acccounts-get-all-subaccounts accounts)
accounts)
report-currency))
(gnc:report-percent-done 5)
(set! exchange-fn (gnc:case-exchange-time-fn
price-source report-currency
commodity-list to-date-tp
5 20))
(gnc:report-percent-done 20)
;; initialize the query to find splits in the right
;; date range and accounts
(gnc:query-set-book query (gnc:get-current-book))
;; for balance purposes, we don't need to do this, but it cleans up
;; the table display.
(gnc:query-set-match-non-voids-only! query (gnc:get-current-book))
;; add accounts to the query (include subaccounts
;; if requested)
(gnc:report-percent-done 25)
(if dosubs?
(let ((subaccts '()))
(for-each
(lambda (acct)
(let ((this-acct-subs
(gnc:account-get-all-subaccounts acct)))
(if (list? this-acct-subs)
(set! subaccts
(append subaccts this-acct-subs)))))
accounts)
;; Beware: delete-duplicates is an O(n^2)
;; algorithm. More efficient method: sort the list,
;; then use a linear algorithm.
(set! accounts
(delete-duplicates (append accounts subaccts)))))
(gnc:report-percent-done 30)
(gnc:query-add-account-match query accounts 'guid-match-any 'query-and)
;; match splits between start and end dates
(gnc:query-add-date-match-timepair
query #t from-date-tp #t to-date-tp 'query-and)
(gnc:query-set-sort-order query
(list gnc:split-trans gnc:trans-date-posted)
(list gnc:query-default-sort)
'())
;; get the query results
(set! splits (gnc:query-get-splits query))
(gnc:report-percent-done 40)
;; find the net starting balance for the set of accounts
(set! startbal
(gnc:accounts-get-balance-helper
accounts
(lambda (acct) (gnc:account-get-comm-balance-at-date
acct beforebegindate #f))
gnc:account-reverse-balance?))
(gnc:report-percent-done 50)
(set! startbal
(gnc:numeric-to-double
(gnc:gnc-monetary-amount
(gnc:sum-collector-commodity
startbal
report-currency
(lambda (a b)
(exchange-fn a b beforebegindate))))))
(gnc:report-percent-done 60)
;; and analyze the data
(set! data (analyze-splits splits startbal
from-date-tp to-date-tp
DayDelta monetary->double))
(gnc:report-percent-done 70)
;; now, in data we have a list of (start-date end-date avg-bal
;; max-bal min-bal total-in total-out net). what we really
;; want is just the last element, #7.
(for-each
(lambda (split)
(let ((k (modulo (- (gnc:timepair-get-week-day
(list-ref split 1)) 1) 7))) ; end-date
(list-set! daily-totals k
(+ (list-ref daily-totals k)
(list-ref split 7))))) ; net
data)
(let* ((zipped-list (filter (lambda (p)
(not (zero? (cadr p)))) (zip days-of-week
daily-totals)))
(labels (map (lambda (p)
(if show-total?
(string-append
(car p)
" - "
(gnc:amount->string
(gnc:double-to-gnc-numeric
(cadr p)
(gnc:commodity-get-fraction report-currency)
GNC-RND-ROUND)
print-info))
(car p)))
zipped-list)))
(if (not (null? zipped-list))
(begin
(gnc:html-piechart-set-title! chart report-title)
(gnc:html-piechart-set-width! chart width)
(gnc:html-piechart-set-height! chart height)
(gnc:html-piechart-set-subtitle!
chart (string-append
(sprintf #f
(_ "%s to %s")
(gnc:print-date from-date-tp)
(gnc:print-date to-date-tp))
(if show-total?
(let ((total (apply + daily-totals)))
(sprintf
#f ": %s"
(gnc:amount->string
(gnc:double-to-gnc-numeric
total
(gnc:commodity-get-fraction report-currency)
GNC-RND-ROUND)
print-info)))
"")))
(gnc:html-piechart-set-data! chart (map cadr zipped-list))
(gnc:html-piechart-set-colors!
chart (gnc:assign-colors (length zipped-list)))
(gnc:html-piechart-set-labels! chart labels)
(gnc:html-document-add-object! document chart))
(gnc:html-document-add-object!
document
(gnc:html-make-empty-data-warning
report-title (gnc:report-id report-obj))))))
(gnc:html-document-add-object!
document
(gnc:html-make-empty-data-warning
report-title (gnc:report-id report-obj))))
(gnc:report-finished)
document))
(for-each
(lambda (l)
(gnc:define-report
'version 1
'name (car l)
'menu-path (list gnc:menuname-income-expense)
'menu-name (caddr l)
'menu-tip (car (cdddr l))
'options-generator (lambda () (options-generator (cadr l)))
'renderer (lambda (report-obj)
(piechart-renderer report-obj
(car l)
(cadr l)))))
(list
;; reportname, account-types, menu-reportname, menu-tip
(list reportname-income '(income) menuname-income menutip-income)
(list reportname-expense '(expense) menuname-expense menutip-expense)))

1
src/report/standard-reports/standard-reports.scm
View File

@ -73,6 +73,7 @@
(use-modules (gnucash report balance-sheet))
(use-modules (gnucash report cash-flow))
(use-modules (gnucash report category-barchart))
(use-modules (gnucash report daily-reports))
(use-modules (gnucash report net-barchart))
(use-modules (gnucash report pnl))
(use-modules (gnucash report portfolio))