From: Neil Jerram <firstname.lastname@example.org> To: Daniele Nicolodi <email@example.com> Cc: Org Mode List <firstname.lastname@example.org> Subject: Re: org-tables with monetary amounts Date: Fri, 25 Sep 2020 10:25:31 +0100 [thread overview] Message-ID: <CAKuG=vtDvqK82Dgxo2PSfLP3YTdvS37h1_jXn_keXTjQmFhgDw@mail.gmail.com> (raw) In-Reply-To: <email@example.com> [-- Attachment #1.1: Type: text/plain, Size: 2029 bytes --] On Tue, 22 Sep 2020 at 17:05, Daniele Nicolodi <firstname.lastname@example.org> 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)))
next prev 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: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style List information: https://www.orgmode.org/ * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to='CAKuG=vtDvqK82Dgxo2PSfLP3YTdvS37h1_jXn_keXTjQmFhgDw@mail.gmail.com' \ --email@example.com \ --firstname.lastname@example.org \ --email@example.com \ --subject='Re: org-tables with monetary amounts' \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: link
Code repositories for project(s) associated with this inbox: https://git.savannah.gnu.org/cgit/emacs/org-mode.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).