diff --git a/group-expense/2025.scm b/group-expense/2025.scm new file mode 100644 index 0000000..b5958c4 --- /dev/null +++ b/group-expense/2025.scm @@ -0,0 +1,8 @@ +( + (laura 67.65 (lisa laura johannes kieran)) + (lisa 24 (lisa laura johannes kieran)) ; brotmuseum + (lisa 19.98 (lisa)) ; kaffee + tabs + (lisa 10.45 (laura)) ; honig + nüsse + (lisa 5.99 (lisa laura johannes kieran)) ; vegane würste + nüsse + (johannes 1.89 (lisa laura johannes kieran)) ; reeses +) diff --git a/group-expense/group-expense b/group-expense/group-expense new file mode 100755 index 0000000..c16f5c1 --- /dev/null +++ b/group-expense/group-expense @@ -0,0 +1,90 @@ +#! /usr/bin/env -S guile --r7rs -q -s +!# + +(use-modules (srfi srfi-1) + (srfi srfi-69) + (ice-9 pretty-print)) + +(define (balance expenses) + (define (add-expense! totals expense) + (let* ((payer (car expense)) + (amount (cadr expense)) + (participants (caddr expense)) + (num-participants (length participants)) + (share (/ amount num-participants))) + ;; charge each participant + (for-each + (lambda (participant) + (when (not (equal? participant payer)) + (hash-table-update! totals participant + (lambda (x) (- x share)) + (lambda () 0)))) + participants) + ;; update payer + (hash-table-update! totals payer + (lambda (x) (+ x amount)) + (lambda () 0)))) + (define totals (make-hash-table)) + (for-each (lambda (expense) + (add-expense! totals expense)) + expenses) + totals) + +; settle balances +(define (settle balances) + (let ((debtors (filter (lambda (p) (< (cdr p) 0)) + (hash-table->alist balances))) + (creditors (filter (lambda (p) (> (cdr p) 0)) + (hash-table->alist balances)))) + (let loop ((debtors debtors) + (creditors creditors) + (result '())) + (cond + ;; done + ((or (null? debtors) (null? creditors)) + result) + + (else + (let* ((debtor (car debtors)) + (creditor (car creditors)) + (dname (car debtor)) + (cname (car creditor)) + (damt (- (cdr debtor))) ; make positive + (camt (cdr creditor)) + (amt (min damt camt)) ; settlement amount + + ;; updated remaining amounts + (drem (- damt amt)) + (crem (- camt amt)) + + ;; updated lists + (new-debtors + (if (= drem 0) + (cdr debtors) + (cons (cons dname (- drem)) + (cdr debtors)))) + + (new-creditors + (if (= crem 0) + (cdr creditors) + (cons (cons cname crem) + (cdr creditors))))) + + (loop new-debtors + new-creditors + (cons (list dname cname amt) result)))))))) + +(define (load-expenses filename) + (with-input-from-file filename + (lambda () + (read)))) ; read a single S-expression + +;; example +(let* ((expenses-file (or (cadr (command-line)) + (error "Usage: group-expense "))) + (expenses (load-expenses expenses-file)) + (expense-balance (balance expenses))) + (pretty-print (list + (cons 'balances (hash-table->alist expense-balance)) + (cons 'settlement (settle expense-balance)))) + (newline)) diff --git a/group-expense/shell.nix b/group-expense/shell.nix new file mode 100644 index 0000000..207bc9c --- /dev/null +++ b/group-expense/shell.nix @@ -0,0 +1,6 @@ +{ + pkgs ? import { }, +}: +pkgs.mkShell { + packages = [ pkgs.guile ]; +}