mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
* src/scm/report/average-balance.scm: convert to guile module.
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@4737 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Rob Browning
parent
cd3da33488
commit
073955d8e6
@ -7,494 +7,495 @@
|
||||
;; or indirect losses incurred as a result of using this software.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(gnc:support "report/average-balance.scm")
|
||||
|
||||
;; 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")
|
||||
|
||||
(let ((optname-from-date (N_ "From"))
|
||||
(optname-to-date (N_ "To"))
|
||||
(optname-stepsize (N_ "Step Size"))
|
||||
(optname-report-currency (N_ "Report's currency"))
|
||||
(optname-price-source (N_ "Price Source"))
|
||||
(optname-subacct (N_ "Include Sub-Accounts")))
|
||||
(define-module (gnucash report average-balance))
|
||||
|
||||
(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
|
||||
;; Options
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(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 (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))))
|
||||
|
||||
(define (process-interval splits from to start-balance)
|
||||
;; General tab
|
||||
(gnc:options-add-date-interval!
|
||||
options gnc:pagename-general optname-from-date optname-to-date "a")
|
||||
|
||||
(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)))
|
||||
(gnc:options-add-interval-choice!
|
||||
options gnc:pagename-general optname-stepsize "b" 'MonthDelta)
|
||||
|
||||
(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))
|
||||
;; 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
|
||||
; the minmax accumulator
|
||||
|
||||
(minmax-accum 'add start-balance)
|
||||
(minmax-accum 'add start-balance)
|
||||
|
||||
(if (not (null? splits))
|
||||
(split-recurse))
|
||||
(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)))
|
||||
;; 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)))
|
||||
|
||||
(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
|
||||
;; Renderer
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (renderer report-obj)
|
||||
(define (renderer report-obj)
|
||||
|
||||
(define (get-option section name)
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option (gnc:report-options report-obj) section name)))
|
||||
(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))
|
||||
(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))
|
||||
(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")))
|
||||
(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))
|
||||
(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))
|
||||
(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 '()))
|
||||
(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))))
|
||||
(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)
|
||||
(gnc:html-document-set-title! document report-title)
|
||||
;;(warn commodity-list)
|
||||
|
||||
(if (not (null? accounts))
|
||||
(let ((query (gnc:malloc-query))
|
||||
(splits '())
|
||||
(data '()))
|
||||
(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)))))
|
||||
;; 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?))
|
||||
(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)))))
|
||||
|
||||
(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))
|
||||
(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)
|
||||
|
||||
(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)))))
|
||||
(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 (memq 'GLPlot plot-type)
|
||||
(let ((debit-data
|
||||
(map (lambda (row) list-ref row 5) 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))
|
||||
|
||||
;; 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))
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name (N_ "Average Balance")
|
||||
'menu-path (list gnc:menuname-asset-liability)
|
||||
'options-generator options-generator
|
||||
'renderer renderer)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user