Re: org-tables with monetary amounts

[Neil Jerram <neiljerram@gmail.com>]

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

On Tue, 22 Sep 2020 at 17:05, Daniele Nicolodi <daniele@grinta.net> 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,
    Neil

[-- 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)
		    partition-end-date-exclusive
		    previous-partitions
		    (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
			    partition-name
			    (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))
	      (else
	       (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))))
		       initial-pence
		       txs)))

;; 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)))
	     txs)))

;; 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
					    detailed-display
					    (list (car detailed-display)))))
				    (partition-by-sort-function (cdr period-partition)
								categorizer)))))
		(partition-by-period txs
				     (tx-date (car txs))
				     next-start-date-proc)))))

(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))
				     regexp-alist
				     show-all-txs))

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

(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))
						next-start-date-proc))
	       (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")
			      partition-end-balance)
			output)))))))

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

(define (monthly-balance sources initial-date initial-balance)
  (periodic-balance sources
		    initial-date
		    initial-balance
		    start-of-following-month))

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

;; 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))
				     start-of-following-month))))
      period-category-alist)))