fixed average-balance.scm report errors
Ben Stanley
bds02@uow.edu.au
Sun, 02 Sep 2001 22:48:29 +1000
This is a multi-part message in MIME format.
--------------050000010400040300060102
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit
Hi,
I ran into some report errors while trying out some strange options on
the average balance report. The Gain/Loss option produced a report crash...
cstim helped debug - here is the resulting file
/usr/share/gnucash/guile-modules/gnucash/report/average-balance.scm
Ben.
--------------050000010400040300060102
Content-Type: text/plain;
name="average-balance.scm"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="average-balance.scm"
;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; average-balance.scm
;; Report history of account balance and other info
;;
;; Author makes no implicit or explicit guarantee of accuracy of
;; these calculations and accepts no responsibility for direct
;; or indirect losses incurred as a result of using this software.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; depends must be outside module scope -- and should eventually go away.
(gnc:depend "report-html.scm")
(gnc:depend "report-utilities.scm")
(gnc:depend "date-utilities.scm")
(define-module (gnucash report average-balance))
(use-modules (srfi srfi-1))
(use-modules (ice-9 slib))
(define optname-from-date (N_ "From"))
(define optname-to-date (N_ "To"))
(define optname-stepsize (N_ "Step Size"))
(define optname-report-currency (N_ "Report's currency"))
(define optname-price-source (N_ "Price Source"))
(define optname-subacct (N_ "Include Sub-Accounts"))
;;;;;;;;;;;;;;;;;;;;;;;;;
;; Options
;;;;;;;;;;;;;;;;;;;;;;;;;
(define (options-generator)
(let* ((options (gnc:new-options))
;; register a configuration option for the report
(register-option
(lambda (new-option)
(gnc:register-option options new-option))))
;; General tab
(gnc:options-add-date-interval!
options gnc:pagename-general optname-from-date optname-to-date "a")
(gnc:options-add-interval-choice!
options gnc:pagename-general optname-stepsize "b" 'MonthDelta)
;; Report currency
(gnc:options-add-currency!
options gnc:pagename-general optname-report-currency "c")
(gnc:options-add-price-source!
options gnc:pagename-general
optname-price-source "d" 'weighted-average)
;; Account tab
(register-option
(gnc:make-simple-boolean-option
gnc:pagename-accounts optname-subacct
"a" (N_ "Include sub-accounts of all selected accounts") #t))
;; account(s) to do report on
(register-option
(gnc:make-account-list-option
gnc:pagename-accounts (N_ "Accounts")
"b" (N_ "Do transaction report on this account")
(lambda ()
;; FIXME : gnc:get-current-accounts disappeared
(let ((current-accounts '()))
;; If some accounts were selected, use those
(cond ((not (null? current-accounts))
current-accounts)
(else
;; otherwise get some accounts -- here as an
;; example we get the asset and liability stuff
(gnc:filter-accountlist-type
'(bank cash credit asset liability)
;; or: '(bank cash checking savings stock
;; mutual-fund money-market)
(gnc:group-get-account-list (gnc:get-current-group)))))))
#f #t))
;; Display tab
(register-option
(gnc:make-simple-boolean-option
gnc:pagename-display (N_ "Show table")
"a" (N_ "Display a table of the selected data.") #f))
(register-option
(gnc:make-simple-boolean-option
gnc:pagename-display (N_ "Show plot")
"b" (N_ "Display a graph of the selected data.") #t))
(register-option
(gnc:make-list-option
gnc:pagename-display (N_ "Plot Type")
"c" (N_ "The type of graph to generate") (list 'AvgBalPlot)
(list
(vector 'AvgBalPlot (N_ "Average") (N_ "Average Balance"))
(vector 'GainPlot (N_ "Profit") (N_ "Profit (Gain minus Loss)"))
(vector 'GLPlot (N_ "Gain/Loss") (N_ "Gain And Loss")))))
(gnc:options-add-plot-size!
options gnc:pagename-display (N_ "Plot Width") (N_ "Plot Height")
"d" 400 400)
;; Set the general page as default option tab
(gnc:options-set-default-section options gnc:pagename-general)
options))
;;;;;;;;;;;;;;;;;;;;;;;;;
;; Some utilities for generating the data
;;;;;;;;;;;;;;;;;;;;;;;;;
(define columns
;; Watch out -- these names should be consistent with the display
;; option where you choose them, otherwise users are confused.
(list (_ "Period start") (_ "Period end") (_ "Average")
(_ "Maximum") (_ "Minimum") (_ "Gain")
(_ "Loss") (_ "Profit") ))
;; 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 (gnc:timepair-to-datestring interval-start)
(gnc:timepair-to-datestring 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)))
;;;;;;;;;;;;;;;;;;;;;;;;;
;; Renderer
;;;;;;;;;;;;;;;;;;;;;;;;;
(define (renderer report-obj)
(define (get-option section name)
(gnc:option-value
(gnc:lookup-option (gnc:report-options report-obj) section name)))
(let* ((report-title (get-option gnc:pagename-general
gnc:optname-reportname))
(begindate (gnc:timepair-start-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general optname-from-date))))
(enddate (gnc:timepair-end-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general optname-to-date))))
(stepsize (eval (get-option gnc:pagename-general optname-stepsize)))
(report-currency (get-option gnc:pagename-general
optname-report-currency))
(price-source (get-option gnc:pagename-general
optname-price-source))
(accounts (get-option gnc:pagename-accounts (N_ "Accounts")))
(dosubs? (get-option gnc:pagename-accounts optname-subacct))
(plot-type (get-option gnc:pagename-display (N_ "Plot Type")))
(show-plot? (get-option gnc:pagename-display (N_ "Show plot")))
(show-table? (get-option gnc:pagename-display (N_ "Show table")))
(document (gnc:make-html-document))
(commodity-list (gnc:accounts-get-commodities
(append
(gnc:acccounts-get-all-subaccounts accounts)
accounts)
report-currency))
(exchange-fn (gnc:case-exchange-time-fn
price-source report-currency
commodity-list enddate))
(beforebegindate (gnc:timepair-end-day-time
(gnc:timepair-previous-day begindate)))
(all-zeros? #t)
;; startbal will be a commodity-collector
(startbal '()))
(define (list-all-zeros? alist)
(if (null? alist) #t
(if (not (= 0.0 (car alist)))
#f
(list-all-zeros? (cdr alist)))))
(define (monetary->double foreign-monetary date)
(gnc:numeric-to-double
(gnc:gnc-monetary-amount
(exchange-fn foreign-monetary report-currency date))))
(gnc:html-document-set-title! document report-title)
;;(warn commodity-list)
(if (not (null? accounts))
(let ((query (gnc:malloc-query))
(splits '())
(data '()))
;; initialize the query to find splits in the right
;; date range and accounts
(gnc:query-set-group query (gnc:get-current-group))
;; add accounts to the query (include subaccounts
;; if requested)
(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:query-add-account-match
query (gnc:list->glist accounts)
'acct-match-any 'query-and)
;; match splits between start and end dates
(gnc:query-add-date-match-timepair
query #t begindate #t enddate 'query-and)
(gnc:query-set-sort-order
query 'by-date 'by-standard 'by-none)
;; get the query results
(set! splits (gnc:glist->list (gnc:query-get-splits query)
<gnc:Split*>))
;; 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?))
(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))))))
;; and analyze the data
(set! data (analyze-splits splits startbal
begindate enddate
stepsize monetary->double))
;; make a plot (optionally)... if both plot and table,
;; plot comes first.
(if show-plot?
(let ((barchart (gnc:make-html-barchart))
(width (get-option gnc:pagename-display
(N_ "Plot Width")))
(height (get-option gnc:pagename-display
(N_ "Plot Height")))
(col-labels '())
(col-colors '()))
(if (memq 'AvgBalPlot plot-type)
(let
((number-data
(map
(lambda (row) (list-ref row 2)) data)))
(if (not (list-all-zeros? number-data))
(begin
(gnc:html-barchart-append-column!
barchart
(map (lambda (row) (list-ref row 2)) data))
(set! col-labels
(append col-labels
(list (list-ref columns 2))))
(set! col-colors
(append col-colors (list "blue")))
(set! all-zeros? #f)))))
(if (memq 'GainPlot plot-type)
(let ((number-data
(map (lambda (row) (list-ref row 7)) data)))
(if (not (list-all-zeros? number-data))
(begin
(gnc:html-barchart-append-column!
barchart
(map (lambda (row) (list-ref row 7)) data))
(set! col-labels
(append col-labels
(list (list-ref columns 7))))
(set! col-colors
(append col-colors (list "green")))
(set! all-zeros? #f)))))
(if (memq 'GLPlot plot-type)
(let ((debit-data
(map (lambda (row) list-ref row 5) data))
(number-data
(map (lambda (row) (list-ref row 7)) data))
(credit-data
(map (lambda (row) list-ref row 6) data)))
;; debit column
(if (not (and
(list-all-zeros? debit-data)
(list-all-zeros? credit-data)))
(begin
(gnc:html-barchart-append-column!
barchart
number-data)
(set! col-labels
(append col-labels
(list (list-ref columns 5))))
(set! col-colors
(append col-colors (list "black")))
;; credit
(gnc:html-barchart-append-column!
barchart
(map (lambda (row) (list-ref row 6)) data))
(set! col-labels
(append col-labels
(list (list-ref columns 6))))
(set! col-colors
(append col-colors (list "red")))
(set! all-zeros? #f)))))
(if (not all-zeros?)
(begin
(gnc:html-barchart-set-col-labels!
barchart col-labels)
(gnc:html-barchart-set-col-colors!
barchart col-colors)
(gnc:html-barchart-set-row-labels!
barchart (map car data))
(gnc:html-barchart-set-row-labels-rotated?! barchart #t)
(gnc:html-barchart-set-width! barchart width)
(gnc:html-barchart-set-height! barchart height)
(gnc:html-barchart-set-height! barchart height)
(gnc:html-document-add-object! document barchart))
(gnc:html-document-add-object!
document
(gnc:html-make-empty-data-warning
(_ "Average Balance"))))))
;; make a table (optionally)
(if show-table?
(let ((table (gnc:make-html-table)))
(gnc:html-table-set-col-headers!
table columns)
(for-each-in-order
(lambda (row)
(gnc:html-table-append-row! table row))
data)
;; set numeric columns to align right
(for-each
(lambda (col)
(gnc:html-table-set-col-style!
table col "td"
'attribute (list "align" "right")))
'(2 3 4 5 6 7))
(gnc:html-document-add-object! document table))))
;; if there are no accounts selected...
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning)))
document))
(gnc:define-report
'version 1
'name (N_ "Average Balance")
'menu-path (list gnc:menuname-asset-liability)
'options-generator options-generator
'renderer renderer)
--------------050000010400040300060102--