Fwd: gnucash monthly report
Christian Stimming
stimming at tuhh.de
Sat Feb 26 12:29:19 EST 2005
Merlin: Thanks for submitting this; however, I currently don't do any work on
reports, so I guess someone else on the gnucash-devel list should pick this
up and check whether it's of general use. Probably it would be good to add
this report to gnucash as well, but some people here should check it out
first.
Thanks,
Christian
---------- Weitergeleitete Nachricht ----------
Subject: gnucash monthly report
Date: Samstag, 26. Februar 2005 16:07
From: merlin hughes <merlin at merlin.org>
To: Christian Stimming <stimming at tuhh.de>
Hi Christian,
Apologies for writing to you personally but you seem to have
written most of the Gnucash reports..
Should GnuCash be interested, I attach a new report; it
is a monthly cash flow statement of sorts, which gives
a month-by-month break down of income vs expenses. It is
similar to the P&L report, but where that considers all
income and expenses, this only considers money going into
and out of current accounts, so it is more useful for simple
people like me who just want to know, on a monthly basis,
how much they are earning and spending. So it doesn't count
gross income, investment transactions, etc. It also has
support for escrow accounts which get paid into regularly
and paid out of periodically; they get counted as monthly
regular expenses rather than period large expenses.
I'm not really familiar with scheme and a very recent gnucash
user, so it's probably a bit rough around the edges..
Merlin
-------------------------------------------------------
-------------- next part --------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; merlin-report.scm: Monthly Cash Flow v0.1
;;
;; By Merlin Hughes <merlin AT merlin DOT org>
;;
;; Largely borrowed from hello-world.scm etc.
;;
;; 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 at gnu.org
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; A really junkly monthly current cashflow report.
;;
;; Basically lets you know on a month-by-month basis how much you
;; are earning and spending.
;;
;; Only reports income and expenses to and from your "current"
;; accounts. By "current" I mean cash, checking, credit cards
;; and loans - what you live on, rather than investments.
;;
;; Income that goes directly to non-current accounts, such as
;; 401-K contributions, is not displayed. Expenses that come from
;; non-current accounts (e.g., federal tax from your salary,
;; investment account charges) are not displayed. This is obviously
;; overkill unless you, like me, take monthly salary and split the
;; transaction so gross salary gets spread among 401-K,
;; insurance, checking account, etc. Minimum payments on credit card
;; accounts are not considered; only the monthly interest
;; accrued.
;;
;; Also has support for escrow accounts, useful for TransitChecks,
;; Flex Spending Accounts, Property Tax Escrow, etc: The report
;; considers income payments into escrow accounts as expenses, and it
;; ignores payments from these accounts. Thus, escrow payments
;; that are paid in regularly and withdrawn from sporadically look
;; like regular expenses which is easier to mentally reconcile.
;; For example, every month part of my mortgage payment is placed in
;; a property tax escrow account. Every quarter property tax is paid
;; out of this account. I'm kinda pedantic so I have this account split
;; out as an asset of mine, with monthly transfers into it and quarterly
;; expenses out of it. Ditto, my FSA gets fed into monthly but I only
;; get doctor bills occasionally. Similarly, TransitCheck payments are
;; made monthly, but I only get and spend the cheques in bulk every
;; few months. In this report, I see regular monthly expenses rather
;; than sporadic large expenses.
;;
;; Includes monthly summaries of major account categories with before
;; and after values, percentage change and, for investment
;; accounts, the approximate percentage change without contributions.
;; Lets you, at a glance, see how the underlying investments
;; are doing, discounting 401-K/IRA contributions,
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; In my Current Accounts I have:
;; /Assets/Current Assets/Cash in Wallet
;; /Assets/Current Asets/Checking Account/Foo Bank
;; /Liabilities/Credit Card/Foo
;; /Liabilities/Credit Card/Bar
;; /Liabilities/Credit Card/Baz
;; /Liabilities/Education Loan/Foo
;; /Liabilities/Education Loan/Bar
;; /Liabilities/Mortgage Loan/Foo
;;
;; In my Escrow Accounts I have:
;; /Assets/Escrow Assets/Property Tax Escrow
;; /Assets/Escrow Assets/Transit Checks
;; /Assets/Escrow Assets/Flex Spending (Medical)
;;
;; In my Summary Accounts I have:
;; /Assets/Current Asets/Checking Account/Foo Bank
;; /Assets/Investments/Retirement
;; /Assets/Investments/Shares
;; /Liabilities/Credit Card
;; /Liabilities/Education Loan
;; /Liabilities/Mortgage Loan
;;
;; Note that all my liabilities are 'current' because they
;; get paid monthly, interest compounds monthly; I want to
;; see that new interest registering as a monthly expense.
;; Ugly, I know.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report merlin-report))
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (gnucash gnc-module))
(load-from-path "substring-search.scm")
(debug-enable 'debug)
(debug-enable 'backtrace)
; (require 'printf)
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/gnome-utils" 0) ;for gnc:html-build-url
(define (delete-if! thunk l)
(let ((head (cons #t l)))
(let loop ((cur l) (prev head))
(cond ((null? cur) (cdr head))
((thunk (car cur)) (set-cdr! prev (cdr cur))
(loop (cdr cur) prev))
(else (loop (cdr cur) cur))))))
(define (delete-unless! thunk l)
(delete-if! (lambda (item) (not (thunk item))) l))
(define (delete-unless thunk l)
(let ((head (list #t)))
(let loop ((cur l) (prev head))
(cond ((null? cur) (cdr head))
((thunk (car cur)) (set-cdr! prev (list (car cur)))
(loop (cdr cur) (cdr prev)))
(else (loop (cdr cur) prev))))))
(define (delete-if thunk l)
(delete-unless (lambda (item) (not (thunk item))) l))
(define (apply-to-account-group* thunk group)
(let loop ((index 0))
(cond ((< index (gnc:group-get-num-accounts group))
(apply-to-account* thunk (gnc:group-get-account group index))
(loop (1+ index))))))
(define (apply-to-account* thunk account)
(if (thunk account)
(apply-to-account-group* thunk (gnc:account-get-children account))))
(define (apply-to-all-accounts thunk)
(apply-to-account-group* thunk (gnc:get-current-group)))
(define (account-get-type account)
(gw:enum-<gnc:AccountType>-val->sym (gnc:account-get-type account) #f))
(define (tree-collect tree-iterator tester)
(let* ((head (list #t)) (tail head))
(define (collector item)
(let ((result (tester item)))
(if (memv result '(add add-and-descend))
(begin (set-cdr! tail (list item))
(set! tail (cdr tail))))
(memv result '(descend add-and-descend))))
(tree-iterator collector)
(cdr head)))
(define (applicator root)
(lambda (thunk)
(if root (apply-to-account* thunk root) (apply-to-all-accounts thunk))))
(define (collect-accounts-by-type type-or-types root)
(let ((type-test (if (symbol? type-or-types) eqv? memv)))
(define (tester account)
(if (type-test (account-get-type account) type-or-types) 'add-and-descend 'descend))
(tree-collect (applicator root) tester)))
(define (collect-accounts root)
(tree-collect (applicator root) (lambda (account) 'add-and-descend)))
; derived from cash-flow.scm ... (not? (does? (work? equal?)))
(define (account-same? a1 a2)
(string=? (gnc:account-get-guid a1) (gnc:account-get-guid a2)))
(define (account-member? account accounts)
(cond
((null? accounts) #f)
((account-same? (car accounts) account) #t)
(else (account-member? account (cdr accounts)))))
(define (account-assoc account alist)
(cond
((null? alist) #f)
((account-same? (caar alist) account) (car alist))
(else (account-assoc account (cdr alist)))))
(define (split-same? s1 s2)
(string=? (gnc:split-get-guid s1) (gnc:split-get-guid s2)))
(define (month-start month year)
(gnc:timepair-start-day-time (gnc:dmy2timespec 1 month year)))
(define (month-end month year)
(gnc:timepair-end-day-time (gnc:dmy2timespec (gnc:days-in-month month year) month year)))
;; compares map entry values
(define (entry-comparator a b)
(> (gnc:numeric-compare (cdr a) (cdr b)) 0))
(define (entry-worthless-p entry)
(gnc:numeric-zero-p (cdr entry)))
(define (limit-digits x num)
(let ((chars (string->list (number->string x))))
(let loop ((c chars) (n -1))
(cond ((null? c) '())
((< n 0) (loop (cdr c) (if (eq? (car c) #\.) (1- num) n)))
((> n 0) (loop (cdr c) (1- n)))
(#t (set-cdr! c '()))))
(list->string chars)))
(define (percent-change from to)
(let* ((diff (gnc:numeric-sub-fixed to from))
(fraction (/ (gnc:numeric-to-double diff) (gnc:numeric-to-double from))))
(string-append (limit-digits (* fraction 100) 2) "%")))
(define numeric-zero (gnc:numeric-zero))
(define (numeric-abs-<? a b)
(< (gnc:numeric-compare (gnc:numeric-abs a) (gnc:numeric-abs b)) 0))
(define (numeric-sign a)
(gnc:numeric-compare a numeric-zero))
(define (get-splits from to)
(let ((query (gnc:malloc-query)))
(gnc:query-set-book query (gnc:get-current-book))
(gnc:query-add-date-match-timepair query #t from #t to 'query-and)
(let ((splits (gnc:query-get-splits query)))
(gnc:free-query query)
splits)))
;; This only works properly for 1:1 transfers or a lookup from the n side of a 1:n
;; transfer (e.g., checking account salary deposit, finding the salary source
;; where the salary is split amoung taxes, insurance and the checking account).
;; In the case of a m:n transfer, it returns the largest source; this is useful
;; e.g., in the rare case where a salary payment includes a small transfer back
;; from a FSA account, which occurred to me on 01/21/2005, so there are two
;; fund sources in the transaction
(define (split-get-corr-account split)
(let* ((transaction (gnc:split-get-parent split))
(sign (numeric-sign (gnc:split-get-amount split))))
(let loop ((index 0)
(match (gnc:split-get-other-split split)) ; hack for $0.00 case
(match-amount numeric-zero))
(if (= index (gnc:transaction-get-split-count transaction))
(gnc:split-get-account match)
(let* ((other (gnc:transaction-get-split transaction index))
(other-amount (gnc:split-get-amount other))
(other-sign (numeric-sign other-amount)))
(if (or (= sign other-sign) (numeric-abs-<? other-amount match-amount))
(loop (1+ index) match match-amount)
(loop (1+ index) other other-amount)))))))
;; returns a map from accounts -> total amount
(define (merge-splits splits from)
(let ((alist '()))
(for-each
(lambda (split)
(let* ((account ((if from gnc:split-get-account split-get-corr-account) split))
(amount (gnc:split-get-amount split))
(pair (account-assoc account alist)))
(if (not pair)
(set! alist (append alist (list (cons account amount))))
(set-cdr! pair (gnc:numeric-add-fixed (cdr pair) amount)))))
splits)
alist))
(define (account-table-cell account)
(gnc:make-html-table-cell/markup
"text-cell"
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:account-anchor-text account)
(gnc:account-get-name account)))))
(define (gen-monthly-table entries)
(let* ((nonzero (delete-if! entry-worthless-p entries))
(sorted (sort nonzero entry-comparator))
(table (gnc:make-html-table))
(currency (gnc:default-currency))
(total numeric-zero))
(define (add-entry entry)
(let ((account (car entry))
(amount (cdr entry)))
(gnc:html-table-append-row/markup!
table
"normal-row"
(list (account-table-cell account)
(gnc:make-html-table-cell/markup
"number-cell" (gnc:make-gnc-monetary currency amount))))
(set! total (gnc:numeric-add-fixed total amount))))
(gnc:html-table-set-col-headers!
table
(list (_ "Source")
(_ "Amount")))
(for-each add-entry sorted)
(gnc:html-table-append-row/markup!
table
"alternate-row"
(list (gnc:make-html-table-cell/markup
"total-label-cell" (_ "Total"))
(gnc:make-html-table-cell/markup
"total-number-cell" (gnc:make-gnc-monetary currency total))))
table))
(define optname-from-date (N_ "From"))
(define optname-to-date (N_ "To"))
(define pagename-current-accounts (N_ "Current Accounts"))
(define optname-current-accounts (N_ "Current Accounts"))
(define pagename-escrow-accounts (N_ "Escrow Accounts"))
(define optname-escrow-accounts (N_ "Escrow Accounts"))
(define pagename-summary-accounts (N_ "Summary Accounts"))
(define optname-summary-accounts (N_ "Summary Accounts"))
(define search-for-Escrow (substring-search-maker "Escrow"))
(define search-for-Salary (substring-search-maker "Salary"))
;; All apex asset accounts with "Escrow" in name
(define (escrow-apex-test account)
(if (and (memv (account-get-type account) '(bank cash asset))
(search-for-Escrow (gnc:account-get-name account)))
'add 'descend))
;; All apex bank/credit/liability/stock/mutual fund accounts
(define (summary-apex-test account)
(if (memv (account-get-type account) '(bank credit liability stock mutual-fund))
'add 'descend))
;; All apex income accounts with "Salary" in name
(define (salary-apex-test account)
(if (and (eqv? (account-get-type account) 'income)
(search-for-Salary (gnc:account-get-name account)))
'add 'descend))
(define (options-generator)
(let* ((options (gnc:new-options)))
(gnc:options-add-date-interval!
options gnc:pagename-general
optname-from-date optname-to-date "a")
(gnc:register-option
options
(gnc:make-account-list-option
pagename-current-accounts optname-current-accounts
"a"
(N_ "Current accounts from which to consider income and expenses.")
(lambda ()
(collect-accounts-by-type '(bank cash credit liability) #f))
#f #t))
(gnc:register-option
options
(gnc:make-account-list-option
pagename-escrow-accounts optname-escrow-accounts
"a"
(N_ "Escrow accounts to consider as expenses.")
(lambda ()
(let ((escrow-apices (tree-collect apply-to-all-accounts escrow-apex-test)))
(apply append (map collect-accounts escrow-apices))))
#f #t))
(gnc:register-option
options
(gnc:make-account-list-option
pagename-summary-accounts optname-summary-accounts
"a"
(N_ "Accounts to summarize.")
(lambda ()
(tree-collect apply-to-all-accounts summary-apex-test))
#f #t))
(gnc:options-set-default-section options gnc:pagename-general)
options))
(define (merlin-world-renderer report-obj)
(define (get-option pagename optname)
(gnc:option-value
(gnc:lookup-option
(gnc:report-options report-obj) pagename optname)))
(let* ((current-accounts (get-option pagename-current-accounts optname-current-accounts))
(escrow-accounts (get-option pagename-escrow-accounts optname-escrow-accounts))
(summary-accounts (get-option pagename-summary-accounts optname-summary-accounts))
(salary-apices (tree-collect apply-to-all-accounts salary-apex-test))
(salary-accounts (apply append (map collect-accounts salary-apices)))
(from-tp (gnc:date-option-absolute-time
(get-option gnc:pagename-general optname-from-date)))
(to-tp (gnc:date-option-absolute-time
(get-option gnc:pagename-general optname-to-date)))
(to-date (gnc:timepair->date to-tp))
(document (gnc:make-html-document)))
;; split from income to current or escrow account
(define (split-income-p split)
(let ((from (split-get-corr-account split))
(to (gnc:split-get-account split)))
(and (eqv? 'income (account-get-type from))
(or (account-member? to current-accounts)
(account-member? to escrow-accounts)))))
;; I am not interested in expenses that occur directly from income
;; or that occur from investments, just what I spent this month;
;; i.e., cash, credit cards and current accounts.
;; Also I pay monthly into a property tax escrow account, the city
;; tax expenses are quarterly from this account; I want the monthly
;; payments to appear as expenses, the quarterly not to appear
;; I don't want income that goes directly to 401-K investments to
;; appear
(define (split-expense-p split)
(let ((from (split-get-corr-account split))
(to (gnc:split-get-account split)))
;; (if (not to) (write (gnc:transaction-get-description (gnc:split-get-parent split))))
(or (and (account-member? to escrow-accounts) ; transfer to escrow account
(not (eqv? 'expense (account-get-type from)))) ; not tax payment.. could be eqv? 'income
(and (eqv? 'expense (account-get-type to)) ; expense
(account-member? from current-accounts) ; from curr
(not (account-member? from escrow-accounts)))))) ; not from escrow
(define (report-month month year)
(let* ((from (month-start month year))
(to (month-end month year))
(monthly-splits (get-splits from to)))
(define (gen-income-table)
(let* ((income-splits (delete-unless split-income-p monthly-splits))
(income (merge-splits income-splits #f)))
(gen-monthly-table income)))
(define (gen-expense-table)
(let* ((expense-splits (delete-unless split-expense-p monthly-splits))
(expenses (merge-splits expense-splits #t)))
(gen-monthly-table expenses)))
(define (gen-summary-table)
(let* ((table (gnc:make-html-table))
(currency (gnc:default-currency)))
(define (add-account account)
(define (balance-at date)
(let ((balance (gnc:account-get-comm-balance-at-date account date #t))
(fn (gnc:case-exchange-fn 'pricedb-nearest currency date)))
(gnc:gnc-monetary-amount (gnc:sum-collector-commodity balance currency fn))))
(let* ((before (balance-at from))
(after (balance-at to))
(invs (collect-accounts-by-type '(stock mutual-fund) account))
(after-prime after)
(percent-prime #f))
;; Subtract contributions from a current account or from salary.
;; Dividend/capital gains reinvestments are not subtracted.
(define (subtract-contributions split)
(let ((from (split-get-corr-account split))
(to (gnc:split-get-account split)))
(if (and (account-member? to invs)
(or (account-member? from salary-accounts)
(account-member? from current-accounts)))
(set! after-prime (gnc:numeric-sub-fixed after-prime (gnc:split-get-value split))))))
(for-each subtract-contributions monthly-splits)
;; Should really subtract an additional
;; (/ (* contribution monthly-fractional-change) 2)
;; to remove approximate growth of contribution..
;; Could do it even more precisely but wtf?
(if (not (gnc:numeric-equal after after-prime))
(set! percent-prime (percent-change before after-prime)))
(gnc:html-table-append-row/markup!
table "normal-row"
(list (account-table-cell account)
(gnc:make-html-table-cell/markup
"number-cell" (gnc:make-gnc-monetary currency before))
(gnc:make-html-table-cell/markup
"number-cell" (gnc:make-gnc-monetary currency after))
(gnc:make-html-table-cell/markup
"number-cell" (percent-change before after))
(gnc:make-html-table-cell/markup
"number-cell" (if percent-prime (string-append "(" percent-prime " without contributions)") ""))
))))
(gnc:html-table-set-col-headers!
table (list (_ "Account") (_ "Before") (_ "After") (_ "Change")))
(for-each add-account summary-accounts)
table))
(gnc:html-document-add-object!
document
(gnc:make-html-text
(gnc:html-markup-h2 (string-append (if (< month 10) "0" "") (number->string month) "/" (number->string year)))))
(for-each
(lambda (pair)
(let ((name (car pair))
(generate-table-f (cdr pair)))
(gnc:html-document-add-object!
document
(gnc:make-html-text
(gnc:html-markup-h3 (_ name))))
(gnc:html-document-add-object! document (generate-table-f))))
(list (cons "Income" gen-income-table)
(cons "Expenses" gen-expense-table)
(cons "Summary" gen-summary-table)))))
(gnc:html-document-set-title! document (_ "Monthly Cashflow"))
(let loop ((month (1+ (tm:mon to-date))) (year (+ 1900 (tm:year to-date))))
(cond ((gnc:timepair-ge (gnc:dmy2timespec 1 month year) from-tp)
(report-month month year)
(if (= month 1)
(loop 12 (1- year))
(loop (1- month) year)))))
(gnc:html-document-add-object!
document
(gnc:make-html-text
(gnc:html-markup-p (_ "Have a nice day!"))))
document))
(gnc:define-report
'version 1
'name (N_ "Monthly Cashflow")
'menu-name (N_ "Monthly Cashflow")
'menu-tip (N_ "A monthly report of current income vs expenses")
'menu-path (list gnc:menuname-income-expense)
'options-generator options-generator
'renderer merlin-world-renderer)
More information about the gnucash-devel
mailing list