From 18c67f9db86b354df2ea302b01d61a2647913863 Mon Sep 17 00:00:00 2001 From: Christian Stimming Date: Sat, 29 Mar 2003 22:21:24 +0000 Subject: [PATCH] 2003-03-29 Christian Stimming * src/report/standard-reports/daily-reports.scm: New report "income vs. day of week" by Andy Wingo . git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@8107 57a11ea4-9604-0410-9ed3-97b8803252fd --- AUTHORS | 1 + ChangeLog | 3 + src/report/standard-reports/daily-reports.scm | 535 ++++++++++++++++++ .../standard-reports/standard-reports.scm | 1 + 4 files changed, 540 insertions(+) create mode 100644 src/report/standard-reports/daily-reports.scm diff --git a/AUTHORS b/AUTHORS index 5855903337..04f1e1b6db 100644 --- a/AUTHORS +++ b/AUTHORS @@ -203,6 +203,7 @@ Richard -Gilligan- Uschold tax report & txf export Matthew Vanecek for pg_config configure.in patch Richard Wackerbarth patch to gnc-prices, qif import fixes Rob Walker guile and register patches +Andy Wingo income per day-of-week report David Woodhouse messages British translations Ken Yamaguchi QIF import fixes; MYM import Shimpei Yamashita messages Japanese translation diff --git a/ChangeLog b/ChangeLog index a67f95c2f2..7126f87038 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,8 @@ 2003-03-29 Christian Stimming + * src/report/standard-reports/daily-reports.scm: New report + "income vs. day of week" by Andy Wingo . + * src/engine/gnc-session.c: OpenBSD fix by Todd T. Fries diff --git a/src/report/standard-reports/daily-reports.scm b/src/report/standard-reports/daily-reports.scm new file mode 100644 index 0000000000..de80d4e6fc --- /dev/null +++ b/src/report/standard-reports/daily-reports.scm @@ -0,0 +1,535 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; daily-reports.scm: reports based on the day of the week +;; +;; Copyright (C) 2003, Andy Wingo +;; +;; based on account-piecharts.scm by Robert Merkel (rgmerk@mira.net) +;; and Christian Stimming 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))) diff --git a/src/report/standard-reports/standard-reports.scm b/src/report/standard-reports/standard-reports.scm index 1fcd3656b4..2ed456f9d0 100644 --- a/src/report/standard-reports/standard-reports.scm +++ b/src/report/standard-reports/standard-reports.scm @@ -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))