mirror of
https://github.com/Gnucash/gnucash.git
synced 2024-12-01 21:19:16 -06:00
Robert Graham Merkel's net worth graph + some bug fixes.
* src/scm/report/net-worth-timeseries.scm: New file. You guessed
it, a time series net worth barchart.
* src/scm/report/date-utilities.scm: add gnc:dateloop-simple to
generate simple timeseries for net worth barchart.
* src/scm/report/{Makefile.am, report-list.scm}: add new barchart.
* src/scm/report/balance-sheet.scm (balance-sheet-renderer):
use gnc:decompose-accounts to split up accounts.
* src/scm/report-utilities.scm (gnc:decompose-accountlist):
add credit accounts to the list of liability accounts.
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3919 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas
parent
e5f48598f6
commit
962ac02652
18
ChangeLog
18
ChangeLog
@ -1,3 +1,21 @@
|
||||
2001-04-10 Robert Graham Merkel <rgmerk@mira.net>
|
||||
|
||||
* src/scm/report/net-worth-timeseries.scm: New file. You guessed
|
||||
it, a time series net worth barchart.
|
||||
|
||||
* src/scm/report/date-utilities.scm: add gnc:dateloop-simple to
|
||||
generate simple timeseries for net worth barchart.
|
||||
|
||||
* src/scm/report/{Makefile.am, report-list.scm}: add new barchart.
|
||||
|
||||
2001-04-09 Robert Graham Merkel <rgmerk@mira.net>
|
||||
|
||||
* src/scm/report/balance-sheet.scm (balance-sheet-renderer):
|
||||
use gnc:decompose-accounts to split up accounts.
|
||||
|
||||
* src/scm/report-utilities.scm (gnc:decompose-accountlist):
|
||||
add credit accounts to the list of liability accounts.
|
||||
|
||||
2001-04-08 Dave Peticolas <dave@krondo.com>
|
||||
|
||||
* src/gnome/dialog-price-editor.c: more work
|
||||
|
||||
@ -209,6 +209,16 @@
|
||||
(else (cons (list curd endd '()) '())))))
|
||||
(else '())))
|
||||
|
||||
;; Build a list of evenly spaced times. If dates are unevenly spaced,
|
||||
;; the last interval will be the shorter one/
|
||||
(define (gnc:dateloop-simple curd endd incr)
|
||||
(cond ((gnc:timepair-later curd endd)
|
||||
(let ((nextd (incdate curd incr)))
|
||||
(cons curd (gnc:dateloop-simple nextd endd incr))))
|
||||
|
||||
(else (list endd))))
|
||||
|
||||
|
||||
; A reference zero date - the Beginning Of The Epoch
|
||||
; Note: use of eval is evil... by making this a generator function,
|
||||
; each delta function gets its own instance of Zero Date
|
||||
|
||||
@ -84,7 +84,7 @@
|
||||
(cons (_ "Assets")
|
||||
'(asset bank cash checking savings money-market
|
||||
stock mutual-fund currency))
|
||||
(cons (_ "Liabilities") '(liability credit-line))
|
||||
(cons (_ "Liabilities") '(liability credit credit-line))
|
||||
(cons (_ "Equity") '(equity))
|
||||
(cons (_ "Income") '(income))
|
||||
(cons (_ "Expense") '(expense)))))
|
||||
@ -430,26 +430,26 @@
|
||||
(gnc:group-get-comm-balance-at-date
|
||||
(gnc:account-get-children account) date)
|
||||
(gnc:make-commodity-collector)))
|
||||
(query (gnc:malloc-query))
|
||||
(splits #f))
|
||||
|
||||
(gnc:query-set-group query (gnc:get-current-group))
|
||||
(gnc:query-add-single-account-match query account 'query-and)
|
||||
(gnc:query-add-date-match-timepair query #f date #t date 'query-and)
|
||||
(gnc:query-set-sort-order query 'by-date 'by-standard 'by-none)
|
||||
(gnc:query-set-sort-increasing query #t #t #t)
|
||||
(gnc:query-set-max-splits query 1)
|
||||
|
||||
(set! splits (gnc:glist->list
|
||||
(gnc:query-get-splits query)
|
||||
(query (gnc:malloc-query))
|
||||
(splits #f))
|
||||
|
||||
(gnc:query-set-group query (gnc:get-current-group))
|
||||
(gnc:query-add-single-account-match query account 'query-and)
|
||||
(gnc:query-add-date-match-timepair query #f date #t date 'query-and)
|
||||
(gnc:query-set-sort-order query 'by-date 'by-standard 'by-none)
|
||||
(gnc:query-set-sort-increasing query #t #t #t)
|
||||
(gnc:query-set-max-splits query 1)
|
||||
|
||||
(set! splits (gnc:glist->list
|
||||
(gnc:query-get-splits query)
|
||||
<gnc:Split*>))
|
||||
(gnc:free-query query)
|
||||
|
||||
(if (and splits (not (null? splits)))
|
||||
(gnc:free-query query)
|
||||
|
||||
(if (and splits (not (null? splits)))
|
||||
(balance-collector 'add (gnc:account-get-commodity account)
|
||||
(gnc:split-get-share-balance (car splits))))
|
||||
balance-collector))
|
||||
|
||||
balance-collector))
|
||||
|
||||
;; get the balance of a group of accounts at the specified date
|
||||
;; inlcuding child accounts.
|
||||
(define (gnc:group-get-balance-at-date group date)
|
||||
|
||||
@ -9,6 +9,7 @@ gncscm_DATA = \
|
||||
hello-world.scm \
|
||||
income-expense-graph.scm \
|
||||
income-or-expense-pie.scm \
|
||||
net-worth-timeseries.scm \
|
||||
pnl.scm \
|
||||
portfolio.scm \
|
||||
register.scm \
|
||||
|
||||
@ -165,27 +165,23 @@
|
||||
optname-to-date) 1)))
|
||||
|
||||
;; decompose the account list
|
||||
(split-up-accounts (gnc:decompose-accountlist accounts))
|
||||
(dummy (gnc:warn "split-up-accounts" split-up-accounts))
|
||||
(asset-accounts
|
||||
(gnc:filter-accountlist-type
|
||||
'(bank cash asset stock mutual-fund)
|
||||
accounts))
|
||||
(assoc-ref split-up-accounts (_ "Assets")))
|
||||
(liability-accounts
|
||||
(gnc:filter-accountlist-type
|
||||
'(credit liability)
|
||||
accounts))
|
||||
(liability-account-names
|
||||
(map gnc:account-get-name liability-accounts))
|
||||
(assoc-ref split-up-accounts (_ "Liabilities")))
|
||||
; (liability-account-names
|
||||
; (map gnc:account-get-name liability-accounts))
|
||||
; (dummy2
|
||||
; (gnc:warn "liability-account-names" liability-account-names))
|
||||
(equity-accounts
|
||||
(gnc:filter-accountlist-type
|
||||
'(equity)
|
||||
accounts))
|
||||
(assoc-ref split-up-accounts (_"Equity")))
|
||||
(income-expense-accounts
|
||||
(gnc:filter-accountlist-type
|
||||
'(income expense)
|
||||
accounts))
|
||||
;; goonie: I would rather use gnc:decompose-accountlist and
|
||||
;; then continue with a bunch of list processing. Saves
|
||||
;; typing and makes changes a lot easier. -- cstim.
|
||||
(append (assoc-ref split-up-accounts (_ "Income"))
|
||||
(assoc-ref split-up-accounts (_ "Expense"))))
|
||||
|
||||
;; cstim: happy now? :->
|
||||
|
||||
(doc (gnc:make-html-document))
|
||||
(txt (gnc:make-html-text))
|
||||
@ -292,6 +288,7 @@
|
||||
#f
|
||||
show-parent-balance? show-parent-total?
|
||||
show-fcur? report-currency exchange-fn)))
|
||||
|
||||
(retained-profit-balance 'minusmerge
|
||||
neg-retained-profit-balance
|
||||
#f)
|
||||
|
||||
233
src/scm/report/net-worth-timeseries.scm
Normal file
233
src/scm/report/net-worth-timeseries.scm
Normal file
@ -0,0 +1,233 @@
|
||||
;; -*-scheme-*-
|
||||
|
||||
;; net-worth-timeseries.scm
|
||||
;; Display a simple time series for net worth
|
||||
;; by Robert Merkel (rgmerk@mira.net)
|
||||
|
||||
(gnc:support "report/net-worth-timeseries.scm")
|
||||
(gnc:depend "report-html.scm")
|
||||
(gnc:depend "date-utilities.scm")
|
||||
|
||||
(let ((pagename-general (N_ "General"))
|
||||
(optname-from-date (N_ "From"))
|
||||
(optname-to-date (N_ "To"))
|
||||
(optname-accounts (N_ "Accounts"))
|
||||
(optname-stepsize (N_ "Step Size"))
|
||||
(optname-report-currency (N_ "Report's currency"))
|
||||
|
||||
(pagename-display (N_ "Display"))
|
||||
(optname-sep-bars (N_ "Show seperate asset & liability/equity bars?"))
|
||||
(optname-net-bars (N_ "Show net worth bars?"))
|
||||
(optname-plot-width (N_ "Plot Width"))
|
||||
(optname-plot-height (N_ "Plot Height")))
|
||||
|
||||
(define (options-generator)
|
||||
(let* ((options (gnc:new-options))
|
||||
;; This is just a helper function for making options.
|
||||
;; See gnucash/src/scm/options.scm for details.
|
||||
(add-option
|
||||
(lambda (new-option)
|
||||
(gnc:register-option options new-option))))
|
||||
|
||||
(gnc:options-add-date-interval!
|
||||
options pagename-general
|
||||
optname-from-date optname-to-date "a")
|
||||
|
||||
(gnc:options-add-interval-choice!
|
||||
options pagename-general optname-stepsize "b" 'MonthDelta)
|
||||
|
||||
(add-option
|
||||
(gnc:make-account-list-option
|
||||
pagename-general optname-accounts
|
||||
"c"
|
||||
(N_ "Report on these accounts, if chosen account level allows.")
|
||||
(lambda ()
|
||||
(filter
|
||||
(lambda (account) (not (gnc:account-is-inc-exp? account)))
|
||||
(gnc:group-get-subaccounts (gnc:get-current-group))))
|
||||
(lambda (accounts)
|
||||
(list #t
|
||||
(filter (lambda (account)
|
||||
(not (gnc:account-is-inc-exp? account)))
|
||||
accounts)))
|
||||
#t))
|
||||
|
||||
(gnc:options-add-currency!
|
||||
options pagename-general optname-report-currency "d")
|
||||
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
pagename-display optname-sep-bars
|
||||
"a" (N_ "Show Seperate Asset and Liability bars?") #t))
|
||||
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
pagename-display optname-net-bars
|
||||
"b" (N_ "Show A Net Worth bar?") #t))
|
||||
|
||||
|
||||
(gnc:options-add-plot-size!
|
||||
options pagename-display
|
||||
optname-plot-width optname-plot-height "c" 400 400)
|
||||
|
||||
(gnc:options-set-default-section options pagename-general)
|
||||
|
||||
options))
|
||||
|
||||
;; This is the rendering function. It accepts a database of options
|
||||
;; and generates an object of type <html-document>. See the file
|
||||
;; report-html.txt for documentation; the file report-html.scm
|
||||
;; includes all the relevant Scheme code. The option database passed
|
||||
;; to the function is one created by the options-generator function
|
||||
;; defined above.
|
||||
(define (net-worth-series-renderer report-obj)
|
||||
|
||||
;; These are some helper functions for looking up option values.
|
||||
(define (get-op section name)
|
||||
(gnc:lookup-option (gnc:report-options report-obj) section name))
|
||||
|
||||
(define (op-value section name)
|
||||
(gnc:option-value (get-op section name)))
|
||||
|
||||
(define (collector-fn accounts dates)
|
||||
(define (single-account-get-balance account tp)
|
||||
(begin
|
||||
(gnc:debug "account" account)
|
||||
(gnc:debug "tp" tp)
|
||||
(gnc:account-get-comm-balance-at-date
|
||||
account tp #f)))
|
||||
(define (accounts-get-balance tp the-accounts)
|
||||
(gnc:accounts-get-comm-total-assets
|
||||
the-accounts (lambda (account)
|
||||
(single-account-get-balance account tp))))
|
||||
|
||||
(map (lambda (date) (accounts-get-balance date accounts))
|
||||
dates))
|
||||
|
||||
|
||||
(define (collector-to-double-fn report-currency exchange-fn)
|
||||
(lambda (commodity-collector)
|
||||
(gnc:numeric-to-double
|
||||
(gnc:gnc-monetary-amount
|
||||
(gnc:sum-collector-commodity commodity-collector
|
||||
report-currency
|
||||
exchange-fn)))))
|
||||
|
||||
(define (collector-combine asset-collector liability-collector)
|
||||
(let ((new-collector (gnc:make-commodity-collector)))
|
||||
(new-collector 'merge asset-collector #f)
|
||||
(new-collector 'merge liability-collector #f)
|
||||
new-collector))
|
||||
|
||||
|
||||
(let* ((to-date-tp (gnc:timepair-end-day-time
|
||||
(vector-ref (op-value pagename-general
|
||||
optname-to-date) 1)))
|
||||
(from-date-tp (gnc:timepair-start-day-time
|
||||
(vector-ref (op-value pagename-general
|
||||
optname-from-date) 1)))
|
||||
(interval (op-value pagename-general optname-stepsize))
|
||||
(accounts (op-value pagename-general optname-accounts))
|
||||
(classified-accounts (gnc:decompose-accountlist accounts))
|
||||
(asset-accounts
|
||||
(assoc-ref classified-accounts (_"Assets")))
|
||||
(liability-equity-accounts
|
||||
(append
|
||||
(assoc-ref classified-accounts (_ "Liabilities"))
|
||||
(assoc-ref classified-accounts (_ "Equity"))))
|
||||
(report-currency (op-value pagename-general
|
||||
optname-report-currency))
|
||||
|
||||
(show-sep? (op-value pagename-display optname-sep-bars))
|
||||
(show-net? (op-value pagename-display optname-net-bars))
|
||||
; (stacked? (op-value pagename-display optname-stacked))
|
||||
(height (op-value pagename-display optname-plot-height))
|
||||
(width (op-value pagename-display optname-plot-width))
|
||||
|
||||
(document (gnc:make-html-document))
|
||||
(chart (gnc:make-html-barchart))
|
||||
(exchange-alist (gnc:make-exchange-alist
|
||||
report-currency to-date-tp))
|
||||
(exchange-fn-internal (gnc:make-exchange-function exchange-alist))
|
||||
(exchange-fn (lambda (foreign)
|
||||
(exchange-fn-internal foreign report-currency)))
|
||||
(dates-list (gnc:dateloop-simple
|
||||
(gnc:timepair-start-day-time from-date-tp)
|
||||
(gnc:timepair-end-day-time to-date-tp)
|
||||
(eval interval)))
|
||||
(dummy134 (gnc:debug "dates-list" dates-list))
|
||||
(assets-collector-list (collector-fn asset-accounts dates-list))
|
||||
(expense-collector-list (collector-fn liability-equity-accounts dates-list))
|
||||
(net-collector-list (map collector-combine assets-collector-list expense-collector-list))
|
||||
(assets-list
|
||||
(map (collector-to-double-fn report-currency exchange-fn-internal)
|
||||
assets-collector-list))
|
||||
(liability-list
|
||||
(map (collector-to-double-fn report-currency exchange-fn-internal)
|
||||
expense-collector-list))
|
||||
(net-list
|
||||
(map (collector-to-double-fn report-currency exchange-fn-internal)
|
||||
net-collector-list))
|
||||
(date-string-list
|
||||
(map gnc:timepair-to-datestring
|
||||
dates-list)))
|
||||
|
||||
(gnc:html-barchart-set-title! chart (_ "Net Worth Chart"))
|
||||
(gnc:html-barchart-set-subtitle!
|
||||
chart (sprintf #f
|
||||
(_ "%s to %s")
|
||||
(gnc:timepair-to-datestring from-date-tp)
|
||||
(gnc:timepair-to-datestring to-date-tp)))
|
||||
(gnc:html-barchart-set-width! chart width)
|
||||
(gnc:html-barchart-set-height! chart height)
|
||||
(gnc:html-barchart-set-row-labels! chart date-string-list)
|
||||
(gnc:html-barchart-set-y-axis-label!
|
||||
chart (gnc:commodity-get-mnemonic report-currency))
|
||||
; (gnc:html-barchart-set-row-labels-rotated?! chart #t)
|
||||
; (gnc:html-barchart-set-stacked?! chart stacked?)
|
||||
|
||||
(if show-sep?
|
||||
(begin
|
||||
(gnc:html-barchart-append-column! chart assets-list)
|
||||
(gnc:html-barchart-append-column! chart liability-list)))
|
||||
(if show-net?
|
||||
(gnc:html-barchart-append-column!
|
||||
chart net-list))
|
||||
(gnc:html-barchart-set-col-labels!
|
||||
chart (append
|
||||
(if show-sep?
|
||||
(list (_ "Assets") (_ "Liabilities/Equity")) '())
|
||||
(if show-net?
|
||||
(list (_ "Net Worth")) '())))
|
||||
(gnc:html-barchart-set-col-colors!
|
||||
chart (append
|
||||
(if show-sep?
|
||||
'("blue" "red") '())
|
||||
(if show-net?
|
||||
'("green") '())))
|
||||
|
||||
(gnc:html-document-add-object! document chart)
|
||||
|
||||
; (gnc:html-document-add-object!
|
||||
; document ;;(gnc:html-markup-p
|
||||
; (gnc:html-make-exchangerates
|
||||
; report-currency exchange-alist accounts #f))
|
||||
|
||||
document))
|
||||
|
||||
;; Here we define the actual report with gnc:define-report
|
||||
(gnc:define-report
|
||||
|
||||
;; The version of this report.
|
||||
'version 1
|
||||
|
||||
;; The name of this report. This will be used, among other things,
|
||||
;; for making its menu item in the main menu. You need to use the
|
||||
;; untranslated value here!
|
||||
'name (N_ "Net Worth Time Series")
|
||||
|
||||
;; The options generator function defined above.
|
||||
'options-generator options-generator
|
||||
|
||||
;; The rendering function defined above.
|
||||
'renderer net-worth-series-renderer))
|
||||
@ -11,6 +11,7 @@
|
||||
(gnc:depend "report/balance-sheet.scm")
|
||||
(gnc:depend "report/income-expense-graph.scm")
|
||||
(gnc:depend "report/income-or-expense-pie.scm")
|
||||
(gnc:depend "report/net-worth-timeseries.scm")
|
||||
(gnc:depend "report/category-barchart.scm")
|
||||
(gnc:depend "report/pnl.scm")
|
||||
(gnc:depend "report/hello-world.scm")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user