Org-mode mailing list
 help / color / mirror / Atom feed
From: Neil Jerram <>
To: Daniele Nicolodi <>
Cc: Org Mode List <>
Subject: Re: org-tables with monetary amounts
Date: Fri, 25 Sep 2020 10:25:31 +0100
Message-ID: <> (raw)
In-Reply-To: <>

[-- Attachment #1.1: Type: text/plain, Size: 2029 bytes --]

On Tue, 22 Sep 2020 at 17:05, Daniele Nicolodi <> wrote:

> Hello,

Hi Daniele...

> I often use org-tables to work with monetary amounts.

Me too.  I use Org mode plus Scheme code to try to analyze my bank
statements and compare them against a budget.  Org is a convenient form for
specifying the inputs - e.g. the names of OFX files to read, and string
matches for how I want to categorize the transactions - and for displaying
the results.

Aside: Perhaps I'm misunderstanding them, but none of the open source
tools, including (h)ledger, seem to be of much help here.
- They focus on data entry and reconciliation, which I don't need as I'm
happy to download and use OFX files from my bank.
- They don't offer anything intelligent and automated for automatically
categorizing transactions.
- They don't have a sophisticated representation of a budget, and reporting
against that.
Do you know of a good forum (other than this!) for discussing such points?

> It would be very
> nice to have a couple of functionalities common in this domain:
> - fixed precision arithmetic, namely derive the precision of the results
> from the precision of the arguments (I think that calc can do this),

In my Scheme code, I convert between strings and pence:

    ;; In this file, an amount at rest is always represented as a string
    ;; with 2 decimal places.  Convert from that to an integer number of
    ;; pence:

    (define (amount->pence amount)
      (inexact->exact (round (* 100 (string->number amount)))))

    ;; And the reverse:

    (define (pence->amount pence)
      (format-2dp (/ (exact->inexact pence) 100)))

> - support for parsing numbers followed by currencies,
> - correct alignment for monetary values.
> I had a quick look around, but I haven't found anything that implements
> those things. Has anyone some secret code that they would like to share?

I've attached mine, in case you read Scheme and there's more detail in
there that is of interest.

Best wishes,

[-- Attachment #1.2: Type: text/html, Size: 3109 bytes --]

[-- Attachment #2: nationwide.scm --]
[-- Type: text/x-scheme, Size: 8749 bytes --]

(add-to-load-path (in-vicinity (getenv "HOME") "ossaulib"))

(use-modules (ice-9 format)
	     (ice-9 regex)
	     (ossau ofx)
	     (srfi srfi-1)
	     (sxml simple)
	     (sxml match)
	     (srfi srfi-19))

;; (ossau ofx) provides 'get-transactions' to read transactions from a
;; single OFX file.  Let's build on that to read transactions from
;; multiple OFX files, assuming that the files given are already
;; ordered by date, so that the transactions in them follow on from
;; each other.

(define (read-transactions . files)
  (apply append (map get-transactions files)))

;; Return a date that is 00:00 UTC on the day of the given transaction.

(define (tx-date tx)
  (let ((d (string->date (tx:date tx) "~Y~m~d")))
    (make-date 0 0 0 0			; nsec sec min hr
	       (date-day d)
	       (date-month d)
	       (date-year d)
	       0			; zone offset, i.e. UTC

;; Given a date, return a date that is the start of the next month.

(define (start-of-following-month d)
  (if (= (date-month d) 12)
      (make-date 0 0 0 0		; nsec sec min hr
		 1			; day of month
		 1			; month of year
		 (+ (date-year d) 1)
		 0			; zone offset, i.e. UTC
      (make-date 0 0 0 0		; nsec sec min hr
		 1			; day of month
		 (+ (date-month d) 1)
		 (date-year d)
		 0			; zone offset, i.e. UTC

;; Given a date, return a date that is exactly N days later.

(define (n-days-later d n)
  (julian-day->date (+ (date->julian-day d) n)))

;; Compare two dates.

(define (date-before? d1 d2)
  (< (date->julian-day d1) (date->julian-day d2)))

;; Given a series of transactions, partition them into an alist of
;; smaller series according to time periods calculated from START-DATE
;; and NEXT-START-DATE-PROC: the start of the first period is
;; START-DATE, the start of the second period is (NEXT-START-DATE-PROC
;; START-DATE), the start of the third period is (NEXT-START-DATE-PROC
;; (NEXT-START-DATE-PROC START-DATE)), and so on.  In the returned
;; alist, each entry is (DATE . TX-LIST), where DATE is the exclusive
;; period end date (== the start date of the following period) for the
;; transactions in TX-LIST.

(define (partition-by-period txs start-date next-start-date-proc)
  (let loop ((txs txs)
	     (partition-end-date-exclusive (next-start-date-proc start-date))
	     (previous-partitions '())
	     (current-partition '()))
    (if (null? txs)
	(reverse (acons partition-end-date-exclusive current-partition previous-partitions))
	(let* ((tx (car txs)))
	  (if (date-before? (tx-date tx) partition-end-date-exclusive)
	      ;; This transaction is within the current partition.
	      (loop (cdr txs)
		    (cons tx current-partition))
	      ;; This transaction is after the current partition.  But
	      ;; bear in mind that it might not be in the immediate
	      ;; next partition either.  The safest thing to do is to
	      ;; close out the current partition, advance the limit
	      ;; date, then loop round to look at the transaction in
	      ;; hand again.
	      (loop txs
		    (next-start-date-proc partition-end-date-exclusive)
		    (acons partition-end-date-exclusive current-partition previous-partitions)

;; Given a series of transactions, use SORT-FUNCTION to partition them
;; into an alist of smaller series.  We call SORT-FUNCTION on each
;; transaction, and it returns a string indicating the name of the
;; partition that that transaction should belong to.  In the result
;; alist, each entry is (PARTITION-NAME . TX-LIST).

(define (partition-by-sort-function txs sort-function)
  (let loop ((txs txs)
	     (partitions '()))
    (if (null? txs)
	(map (lambda (name-list-pair)
	       (cons (car name-list-pair) (reverse (cdr name-list-pair))))
	     (sort partitions
		   (lambda (x y)
		     (string<? (car x) (car y)))))
	(loop (cdr txs)
	      (let* ((tx (car txs))
		     (partition-name (sort-function tx)))
		(assoc-set! partitions
			    (cons tx (or (assoc-ref partitions partition-name) '()))))))))

;; Given an alist of regexps and partition names, build a
;; SORT-FUNCTION that partitions transactions by matching the
;; transaction description against the regexps.

(define (regexp-alist->sort-function regexp-alist)
  (lambda (tx)
    (let ((description (tx:description tx)))
      (let loop ((regexp-alist regexp-alist))
	(cond ((null? regexp-alist)
	      ((string-match (caar regexp-alist) description)
	       (cdar regexp-alist))
	       (loop (cdr regexp-alist))))))))

;; In this file, an amount at rest is always represented as a string
;; with 2 decimal places.  Convert from that to an integer number of
;; pence:

(define (amount->pence amount)
  (inexact->exact (round (* 100 (string->number amount)))))

;; And the reverse:

(define (pence->amount pence)
  (format-2dp (/ (exact->inexact pence) 100)))

;; Given a series of transactions, return the sum of their amounts.

(define (sum-transactions initial-pence txs)
  (pence->amount (fold (lambda (tx previous-total-pence)
			 (+ previous-total-pence
			    (amount->pence (tx:amount tx))))

;; Given a series of transactions, return an array suitable for Org
;; display that shows their total followed by the constituent
;; transactions and amounts.

(define (display-txs-with-initial-sum txs partition-name)
  (cons (list (string-append "\"" partition-name "\"") (sum-transactions 0 txs) "" "")
	(map (lambda (tx)
	       (list "" "" (tx:description tx) (tx:amount tx)))

;; Examples to put the whole thing together.

(define (categorize-transactions-by-period sources next-start-date-proc regexp-alist show-all-txs)
  (let ((txs (apply read-transactions (map cadr sources)))
	(categorizer (regexp-alist->sort-function regexp-alist)))
    (apply append
	   (map (lambda (period-partition)
		  (cons* 'hline
			 (list (string-append "Period ending "
					     (date->string (car period-partition) "~1"))
			      "" "" "")
			(apply append
			       (map (lambda (name-list-pair)
				      (let ((detailed-display
					     (display-txs-with-initial-sum (cdr name-list-pair)
									   (car name-list-pair))))
					(if show-all-txs
					    (list (car detailed-display)))))
				    (partition-by-sort-function (cdr period-partition)
		(partition-by-period txs
				     (tx-date (car txs))

(define (categorize-transactions-by-week sources regexp-alist show-all-txs)
  (categorize-transactions-by-period sources
				     (lambda (start-date)
				       (n-days-later start-date 7))

(define (categorize-transactions-by-month sources regexp-alist show-all-txs)
  (categorize-transactions-by-period sources

(define (periodic-balance sources initial-date initial-balance next-start-date-proc)
  (let* ((txs (apply read-transactions (map cadr sources))))
    (let loop ((partitions (partition-by-period txs
						(tx-date (car txs))
	       (balance-pence (amount->pence initial-balance))
	       (output (list (list initial-date initial-balance))))
      (if (null? partitions)
	  (reverse output)
	  (let ((partition-end-balance (sum-transactions balance-pence (cdar partitions))))
	    (loop (cdr partitions)
		  (amount->pence partition-end-balance)
		  (cons (list (date->string (caar partitions) "~1")

(define (weekly-balance sources initial-date initial-balance)
  (periodic-balance sources
		    (lambda (start-date)
		      (n-days-later start-date 7))))

(define (monthly-balance sources initial-date initial-balance)
  (periodic-balance sources

(define (two-column-table->alist table)
  (map (lambda (row)
	 (cons (car row) (cadr row)))

;; Comparison against a budget.

(define (sum-transactions-by-month-and-category sources regexp-alist)
  (let ((txs (apply read-transactions (map cadr sources)))
	(categorizer (regexp-alist->sort-function regexp-alist)))
    (let ((period-category-alist
	   (map (lambda (period-partition)
		  (cons (date->string (car period-partition) "~1")
			(map (lambda (name-list-pair)
			       (cons (car name-list-pair)
				     (sum-transactions 0 (cdr name-list-pair))))
			     (partition-by-sort-function (cdr period-partition) categorizer))))
		(partition-by-period txs
				     (tx-date (car txs))

  parent reply	other threads:[~2020-09-25  9:26 UTC|newest]

Thread overview: 18+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-09-22 14:57 Daniele Nicolodi
2020-09-22 23:25 ` Nicholas Savage
2020-09-23  9:37 ` Russell Adams
2020-09-23 16:55 ` Eric S Fraga
2020-09-25 11:20   ` Daniele Nicolodi
2020-09-25 11:57     ` Alan Schmitt
2020-09-23 21:26 ` Nick Dokos
2020-09-24  9:17 ` Christian Moe
2020-09-24 11:47   ` Eric S Fraga
2020-10-09 16:14   ` Daniele Nicolodi
2020-10-12  8:22     ` Christian Moe
2020-10-12  9:43       ` Eric S Fraga
2020-10-13  7:10         ` Derek Feichtinger
2020-10-14  7:38           ` Christian Moe
2020-10-15 20:02       ` Daniele Nicolodi
2020-09-25  9:25 ` Neil Jerram [this message]
2020-09-25 11:35   ` Daniele Nicolodi
2020-09-26 18:38     ` Neil Jerram

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:

  List information:

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='' \ \ \ \

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link

Org-mode mailing list

This inbox may be cloned and mirrored by anyone:

	git clone --mirror list/git/0.git

	# If you have public-inbox 1.1+ installed, you may
	# initialize and index your mirror using the following commands:
	public-inbox-init -V2 list list/ \
	public-inbox-index list

Example config snippet for mirrors.
Newsgroups are available over NNTP:

AGPL code for this site: git clone