mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
2001-05-01 Christian Stimming <stimming@tuhh.de>
* src/scm/report/average-balance.scm: moved from average-balance-2.scm . Fix bug. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@4095 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas
parent
af73f13c53
commit
60ab02516b
@ -1,3 +1,8 @@
|
|||||||
|
2001-05-01 Christian Stimming <stimming@tuhh.de>
|
||||||
|
|
||||||
|
* src/scm/report/average-balance.scm: moved from
|
||||||
|
average-balance-2.scm. Fix bug.
|
||||||
|
|
||||||
2001-04-30 Dave Peticolas <dave@krondo.com>
|
2001-04-30 Dave Peticolas <dave@krondo.com>
|
||||||
|
|
||||||
* src/scm/report/portfolio.scm: fix bug
|
* src/scm/report/portfolio.scm: fix bug
|
||||||
|
|||||||
@ -5,7 +5,6 @@ gncscm_DATA = \
|
|||||||
account-piecharts.scm \
|
account-piecharts.scm \
|
||||||
account-summary.scm \
|
account-summary.scm \
|
||||||
average-balance.scm \
|
average-balance.scm \
|
||||||
average-balance-2.scm \
|
|
||||||
balance-sheet.scm \
|
balance-sheet.scm \
|
||||||
category-barchart.scm \
|
category-barchart.scm \
|
||||||
hello-world.scm \
|
hello-world.scm \
|
||||||
|
|||||||
@ -1,443 +0,0 @@
|
|||||||
;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; average-balance-2.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.
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(gnc:support "report/average-balance-2.scm")
|
|
||||||
|
|
||||||
(gnc:depend "report-html.scm")
|
|
||||||
(gnc:depend "report-utilities.scm")
|
|
||||||
(gnc:depend "date-utilities.scm")
|
|
||||||
|
|
||||||
(let ((optname-subacct (N_ "Include Sub-Accounts"))
|
|
||||||
(optname-report-currency (N_ "Report Currency")))
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; 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))))
|
|
||||||
|
|
||||||
(gnc:options-add-date-interval!
|
|
||||||
options gnc:pagename-general (N_ "From") (N_ "To") "a")
|
|
||||||
|
|
||||||
;; account(s) to do report on
|
|
||||||
(register-option
|
|
||||||
(gnc:make-account-list-option
|
|
||||||
gnc:pagename-accounts (N_ "Accounts")
|
|
||||||
"d" (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 equity)
|
|
||||||
;; or: '(bank cash checking savings stock
|
|
||||||
;; mutual-fund money-market)
|
|
||||||
(gnc:group-get-subaccounts (gnc:get-current-group)))))))
|
|
||||||
#f #t))
|
|
||||||
|
|
||||||
(gnc:options-add-interval-choice!
|
|
||||||
options gnc:pagename-general (N_ "Step Size") "b" 'TwoWeekDelta)
|
|
||||||
|
|
||||||
(register-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
gnc:pagename-accounts optname-subacct
|
|
||||||
"e" (N_ "Include sub-accounts of all selected accounts") #t))
|
|
||||||
|
|
||||||
;; Report currency
|
|
||||||
(gnc:options-add-currency!
|
|
||||||
options gnc:pagename-general optname-report-currency "f")
|
|
||||||
|
|
||||||
(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 (list->vector
|
|
||||||
(list 'AvgBalPlot (N_ "Average") (N_ "Average Balance")))
|
|
||||||
(list->vector
|
|
||||||
(list 'GainPlot (N_ "Net Gain") (N_ "Net Gain")))
|
|
||||||
(list->vector
|
|
||||||
(list '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
|
|
||||||
(list (_ "Period start") (_ "Period end") (_ "Avg Bal")
|
|
||||||
(_ "Max Bal") (_ "Min Bal") (_ "Total In")
|
|
||||||
(_ "Total Out") (_ "Net Change") ))
|
|
||||||
|
|
||||||
;; 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 collector->double
|
|
||||||
;; function.
|
|
||||||
|
|
||||||
;; FIXME: the exchange rate should change every time interval, of
|
|
||||||
;; course, but right now we assume the very last exchange rate to be
|
|
||||||
;; constant over the whole report period. Note that this might get
|
|
||||||
;; *really* complicated.
|
|
||||||
|
|
||||||
(define (analyze-splits splits start-bal
|
|
||||||
start-date end-date interval collector->double)
|
|
||||||
(let ((interval-list
|
|
||||||
(gnc:make-date-interval-list start-date end-date interval))
|
|
||||||
(start-bal-double (collector->double start-bal))
|
|
||||||
(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.
|
|
||||||
(define (get-split-value split)
|
|
||||||
(let ((coll (gnc:make-commodity-collector)))
|
|
||||||
(coll 'add (gnc:account-get-commodity (gnc:split-get-account split))
|
|
||||||
(gnc:split-get-amount split))
|
|
||||||
;; FIXME: not as efficient as it would be possible because I
|
|
||||||
;; only have the collector->double conversion at hand.
|
|
||||||
(collector->double coll)))
|
|
||||||
|
|
||||||
;; 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-amt (gnc:split-get-amount split))
|
|
||||||
(split-time (gnc:transaction-get-date-posted
|
|
||||||
(gnc:split-get-parent split))))
|
|
||||||
|
|
||||||
|
|
||||||
(gnc:debug "split " split)
|
|
||||||
(gnc:debug "split-time " split-time)
|
|
||||||
(gnc:debug "split-amt " split-amt)
|
|
||||||
(gnc:debug "splits " splits)
|
|
||||||
(update-stats (gnc:numeric-to-double 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)
|
|
||||||
(let* ((opt-val
|
|
||||||
(lambda (sec value)
|
|
||||||
(gnc:option-value
|
|
||||||
(gnc:lookup-option (gnc:report-options report-obj) sec value))))
|
|
||||||
(report-title (opt-val gnc:pagename-general gnc:optname-reportname))
|
|
||||||
(begindate (gnc:timepair-start-day-time
|
|
||||||
(gnc:date-option-absolute-time
|
|
||||||
(opt-val gnc:pagename-general (N_ "From")))))
|
|
||||||
(enddate (gnc:timepair-end-day-time
|
|
||||||
(gnc:date-option-absolute-time
|
|
||||||
(opt-val gnc:pagename-general (N_ "To")))))
|
|
||||||
(stepsize (eval (opt-val gnc:pagename-general (N_ "Step Size"))))
|
|
||||||
(accounts (opt-val gnc:pagename-accounts (N_ "Accounts")))
|
|
||||||
(dosubs? (opt-val gnc:pagename-accounts optname-subacct))
|
|
||||||
(report-currency (opt-val gnc:pagename-general
|
|
||||||
optname-report-currency))
|
|
||||||
(plot-type (opt-val gnc:pagename-display (N_ "Plot Type")))
|
|
||||||
(show-plot? (opt-val gnc:pagename-display (N_ "Show plot")))
|
|
||||||
(show-table? (opt-val gnc:pagename-display (N_ "Show table")))
|
|
||||||
(document (gnc:make-html-document))
|
|
||||||
(exchange-alist (gnc:make-exchange-alist
|
|
||||||
report-currency enddate))
|
|
||||||
(exchange-fn (gnc:make-exchange-function exchange-alist))
|
|
||||||
(beforebegindate (gnc:timepair-end-day-time
|
|
||||||
(gnc:timepair-previous-day begindate)))
|
|
||||||
;; startbal will be a commodity-collector
|
|
||||||
(startbal '()))
|
|
||||||
|
|
||||||
(define (collector->double commodity-collector)
|
|
||||||
(gnc:numeric-to-double
|
|
||||||
(gnc:gnc-monetary-amount
|
|
||||||
(gnc:sum-collector-commodity commodity-collector
|
|
||||||
report-currency
|
|
||||||
exchange-fn))))
|
|
||||||
|
|
||||||
(gnc:html-document-set-title! document report-title)
|
|
||||||
|
|
||||||
(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?))
|
|
||||||
|
|
||||||
;; and analyze the data
|
|
||||||
(set! data (analyze-splits splits startbal begindate enddate
|
|
||||||
stepsize collector->double))
|
|
||||||
|
|
||||||
;; make a plot (optionally)... if both plot and table,
|
|
||||||
;; plot comes first.
|
|
||||||
(if show-plot?
|
|
||||||
(let ((barchart (gnc:make-html-barchart))
|
|
||||||
(width (opt-val gnc:pagename-display
|
|
||||||
(N_ "Plot Width")))
|
|
||||||
(height (opt-val gnc:pagename-display
|
|
||||||
(N_ "Plot Height")))
|
|
||||||
(col-labels '())
|
|
||||||
(col-colors '()))
|
|
||||||
(if (memq 'AvgBalPlot plot-type)
|
|
||||||
(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")))))
|
|
||||||
|
|
||||||
(if (memq 'GainPlot plot-type)
|
|
||||||
(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")))))
|
|
||||||
(if (memq 'GLPlot plot-type)
|
|
||||||
(begin
|
|
||||||
;; debit column
|
|
||||||
(gnc:html-barchart-append-column!
|
|
||||||
barchart
|
|
||||||
(map (lambda (row) (list-ref row 5)) 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")))))
|
|
||||||
|
|
||||||
(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)))
|
|
||||||
|
|
||||||
;; 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 2")
|
|
||||||
'menu-path (list gnc:menuname-asset-liability)
|
|
||||||
'options-generator options-generator
|
|
||||||
'renderer renderer))
|
|
||||||
@ -47,7 +47,7 @@
|
|||||||
'(bank cash credit asset liability equity)
|
'(bank cash credit asset liability equity)
|
||||||
;; or: '(bank cash checking savings stock
|
;; or: '(bank cash checking savings stock
|
||||||
;; mutual-fund money-market)
|
;; mutual-fund money-market)
|
||||||
(gnc:group-get-subaccounts (gnc:get-current-group)))))))
|
(gnc:group-get-account-list (gnc:get-current-group)))))))
|
||||||
#f #t))
|
#f #t))
|
||||||
|
|
||||||
(gnc:options-add-interval-choice!
|
(gnc:options-add-interval-choice!
|
||||||
@ -116,19 +116,17 @@
|
|||||||
|
|
||||||
(define (analyze-splits splits start-bal
|
(define (analyze-splits splits start-bal
|
||||||
start-date end-date interval collector->double)
|
start-date end-date interval collector->double)
|
||||||
(let* ((minmax-accum (gnc:make-stats-collector))
|
(let ((interval-list
|
||||||
(stats-accum (gnc:make-stats-collector))
|
(gnc:make-date-interval-list start-date end-date interval))
|
||||||
(gain-loss-accum (gnc:make-drcr-collector))
|
(start-bal-double (collector->double start-bal))
|
||||||
(interval-start start-date)
|
(data-rows '()))
|
||||||
;; Note that this (decdate ... SecDelta) stuff is *vital*
|
|
||||||
;; to make sure that our intervals are *not overlapping*.
|
|
||||||
(interval-end (decdate (incdate start-date interval) SecDelta))
|
|
||||||
(last-balance (collector->double start-bal))
|
|
||||||
(last-balance-time interval-start)
|
|
||||||
(data-rows '()))
|
|
||||||
|
|
||||||
(define (output-row)
|
(define (output-row interval-start
|
||||||
(set! data-rows
|
interval-end
|
||||||
|
stats-accum
|
||||||
|
minmax-accum
|
||||||
|
gain-loss-accum)
|
||||||
|
(set! data-rows
|
||||||
(cons
|
(cons
|
||||||
(list (gnc:timepair-to-datestring interval-start)
|
(list (gnc:timepair-to-datestring interval-start)
|
||||||
(gnc:timepair-to-datestring interval-end)
|
(gnc:timepair-to-datestring interval-end)
|
||||||
@ -153,79 +151,94 @@
|
|||||||
;; only have the collector->double conversion at hand.
|
;; only have the collector->double conversion at hand.
|
||||||
(collector->double coll)))
|
(collector->double coll)))
|
||||||
|
|
||||||
;; initialize the accumulators
|
;; calculate the statistics for one interval - returns a list
|
||||||
(minmax-accum 'reset #f)
|
;; containing the following:
|
||||||
(stats-accum 'reset #f)
|
;; min-max acculumator
|
||||||
(gain-loss-accum 'reset #f)
|
;; average-accumulator
|
||||||
|
;; gain-loss accumulator
|
||||||
(minmax-accum 'add start-bal)
|
;; final balance for this interval
|
||||||
|
;; splits remaining to be processed.
|
||||||
;; Now go through all splits. FIXME: This assumes that there is
|
|
||||||
;; at least one split in each time interval, especially in the
|
;; note that it is assumed that every split in in the list
|
||||||
;; first and the last one. I haven't yet thoroughly thought
|
;; has a date >= from
|
||||||
;; about what happens if that's not the case -- somebody should
|
|
||||||
;; think this through.
|
(define (process-interval splits from to start-balance)
|
||||||
(for-each
|
|
||||||
(lambda (split)
|
(let ((minmax-accum (gnc:make-stats-collector))
|
||||||
;; xtn-date: The date of the current split.
|
(stats-accum (gnc:make-stats-collector))
|
||||||
(let* ((xtn-date
|
(gain-loss-accum (gnc:make-drcr-collector))
|
||||||
(gnc:transaction-get-date-posted
|
(last-balance start-balance)
|
||||||
(gnc:split-get-parent split)))
|
(last-balance-time from))
|
||||||
;; split-amt: The value of this split. Is a double.
|
|
||||||
(split-amt (get-split-value split)))
|
|
||||||
|
(define (update-stats split-amt split-time)
|
||||||
;; procedure to be executed if the current split is in the
|
(let ((time-difference (gnc:timepair-delta
|
||||||
;; interval
|
last-balance-time
|
||||||
(define (split-in-interval)
|
split-time)))
|
||||||
(stats-accum
|
(stats-accum 'add (* last-balance time-difference))
|
||||||
'add (* last-balance
|
(set! last-balance (+ last-balance split-amt))
|
||||||
(gnc:timepair-delta last-balance-time
|
(set! last-balance-time split-time)
|
||||||
xtn-date)))
|
(minmax-accum 'add last-balance)
|
||||||
;; update other stats
|
(gain-loss-accum 'add split-amt)))
|
||||||
(set! last-balance (+ last-balance split-amt))
|
|
||||||
(set! last-balance-time xtn-date)
|
(define (split-recurse)
|
||||||
(minmax-accum 'add last-balance)
|
(if (or (null? splits) (gnc:timepair-gt
|
||||||
(gain-loss-accum 'add split-amt))
|
(gnc:transaction-get-date-posted
|
||||||
|
(gnc:split-get-parent
|
||||||
;; procedure to be executed if the current split is not
|
(car splits))) to))
|
||||||
;; (yet) in the interval
|
#f
|
||||||
(define (split-outside-interval)
|
(let*
|
||||||
(stats-accum
|
((split (car splits))
|
||||||
'add (* last-balance
|
(split-amt (get-split-value split))
|
||||||
(gnc:timepair-delta last-balance-time
|
(split-time (gnc:transaction-get-date-posted
|
||||||
interval-end)))
|
(gnc:split-get-parent split))))
|
||||||
(set! last-balance-time interval-end)
|
|
||||||
(minmax-accum 'add last-balance)
|
|
||||||
|
(gnc:debug "split " split)
|
||||||
;; output a row of info
|
(gnc:debug "split-time " split-time)
|
||||||
(output-row)
|
(gnc:debug "split-amt " split-amt)
|
||||||
(set! interval-start (incdate interval-start interval))
|
(gnc:debug "splits " splits)
|
||||||
(set! interval-end
|
(update-stats split-amt split-time)
|
||||||
(decdate (incdate interval-start interval) SecDelta))
|
(set! splits (cdr splits))
|
||||||
|
(split-recurse))))
|
||||||
;; reset collectors
|
|
||||||
(minmax-accum 'reset #f)
|
; the minmax accumulator
|
||||||
(gain-loss-accum 'reset #f)
|
|
||||||
(stats-accum 'reset #f))
|
(minmax-accum 'add start-balance)
|
||||||
|
|
||||||
;; is this split in the interval?
|
(if (not (null? splits))
|
||||||
(let loop ()
|
(split-recurse))
|
||||||
(if (gnc:timepair-le xtn-date interval-end)
|
|
||||||
;; yes, it is inside interval
|
;; insert a null transaction at the end of the interval
|
||||||
(split-in-interval)
|
(update-stats 0.0 to)
|
||||||
;; otherwise, loop until it is
|
(list minmax-accum stats-accum gain-loss-accum last-balance splits)))
|
||||||
;; in the interval.
|
|
||||||
(begin
|
|
||||||
(split-outside-interval)
|
(for-each
|
||||||
(loop))))))
|
(lambda (interval)
|
||||||
splits)
|
(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)
|
||||||
|
|
||||||
|
|
||||||
;; now spit out the last chunk of data (between the beginning
|
|
||||||
;; of the last interval and the last split)
|
|
||||||
(if (not (gnc:timepair-eq last-balance-time interval-start))
|
|
||||||
(begin
|
|
||||||
(set! interval-end last-balance-time)
|
|
||||||
(output-row)))
|
|
||||||
(reverse data-rows)))
|
(reverse data-rows)))
|
||||||
|
|
||||||
|
|
||||||
@ -238,6 +251,7 @@
|
|||||||
(lambda (sec value)
|
(lambda (sec value)
|
||||||
(gnc:option-value
|
(gnc:option-value
|
||||||
(gnc:lookup-option (gnc:report-options report-obj) sec value))))
|
(gnc:lookup-option (gnc:report-options report-obj) sec value))))
|
||||||
|
(report-title (opt-val gnc:pagename-general gnc:optname-reportname))
|
||||||
(begindate (gnc:timepair-start-day-time
|
(begindate (gnc:timepair-start-day-time
|
||||||
(gnc:date-option-absolute-time
|
(gnc:date-option-absolute-time
|
||||||
(opt-val gnc:pagename-general (N_ "From")))))
|
(opt-val gnc:pagename-general (N_ "From")))))
|
||||||
@ -268,7 +282,7 @@
|
|||||||
report-currency
|
report-currency
|
||||||
exchange-fn))))
|
exchange-fn))))
|
||||||
|
|
||||||
(gnc:html-document-set-title! document (_ "Average Balance"))
|
(gnc:html-document-set-title! document report-title)
|
||||||
|
|
||||||
(if (not (null? accounts))
|
(if (not (null? accounts))
|
||||||
(let ((query (gnc:malloc-query))
|
(let ((query (gnc:malloc-query))
|
||||||
@ -410,13 +424,9 @@
|
|||||||
(gnc:html-document-add-object! document table))))
|
(gnc:html-document-add-object! document table))))
|
||||||
|
|
||||||
;; if there are no accounts selected...
|
;; if there are no accounts selected...
|
||||||
(let ((p (gnc:make-html-text)))
|
(gnc:html-document-add-object!
|
||||||
(gnc:html-text-append!
|
document
|
||||||
p
|
(gnc:html-make-no-account-warning)))
|
||||||
(gnc:html-markup-h2 (_ "No accounts selected"))
|
|
||||||
(gnc:html-markup-p
|
|
||||||
(_ "This report requires accounts to be selected.")))
|
|
||||||
(gnc:html-document-add-object! document p)))
|
|
||||||
document))
|
document))
|
||||||
|
|
||||||
(gnc:define-report
|
(gnc:define-report
|
||||||
|
|||||||
@ -9,7 +9,6 @@
|
|||||||
(gnc:depend "report/net-barchart.scm")
|
(gnc:depend "report/net-barchart.scm")
|
||||||
(gnc:depend "report/account-summary.scm")
|
(gnc:depend "report/account-summary.scm")
|
||||||
(gnc:depend "report/average-balance.scm")
|
(gnc:depend "report/average-balance.scm")
|
||||||
(gnc:depend "report/average-balance-2.scm")
|
|
||||||
(gnc:depend "report/balance-sheet.scm")
|
(gnc:depend "report/balance-sheet.scm")
|
||||||
(gnc:depend "report/account-piecharts.scm")
|
(gnc:depend "report/account-piecharts.scm")
|
||||||
(gnc:depend "report/category-barchart.scm")
|
(gnc:depend "report/category-barchart.scm")
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user