ratios.scm

ratios.scm

(use-modules (srfi srfi-1) (ice-9 match))

(define list-of-weights
  '((CAD USD  700 750)
    (CAD GBP  400 250)
    (EUR GBP  120 100)
    (AUD EUR  150 100)
    (AUD JPY  100 7000)
    (GBP JPY   70 9000)
    (RMB HKD  100 110)))

(define domestic-currency 'GBP)

(define (new-ratios ratios foreign foreign-amt domestic-amt)
  (match (assoc-ref ratios foreign)
    (#f (cons (list foreign foreign-amt domestic-amt) ratios))
    ((old-foreign-amt old-domestic-amt)
     (assoc-set! ratios foreign (list (+ old-domestic-amt domestic-amt)
                                      (+ old-foreign-amt foreign-amt))))))

(define (to-domestic ratios foreign foreign-amt)
  (match (assoc-ref ratios foreign)
    (#f (error "cannot convert" foreign foreign-amt))
    ((old-foreign-amt old-domestic-amt)
     (* foreign-amt (/ old-domestic-amt old-foreign-amt)))))

(define (step-1 weights domestic)
  (define (equals-domestic? c) (eq? c domestic))
  (let lp ((weights weights) (work-list '()) (ratios '()))
    (match weights
      (() (step-2 ratios work-list domestic))
      (((_ _ (? zero?) _) . rest) (lp rest work-list ratios))
      (((_ _ _ (? zero?)) . rest) (lp rest work-list ratios))
      ((((? equals-domestic?) foreign domestic-amt foreign-amt) . rest)
       (lp rest work-list (new-ratios ratios foreign foreign-amt domestic-amt)))
      (((foreign (? equals-domestic?) foreign-amt domestic-amt) . rest)
       (lp rest work-list (new-ratios ratios foreign foreign-amt domestic-amt)))
      (((curr1 curr2 amt1 amt2) . rest)
       (lp rest (cons (list curr1 curr2 amt1 amt2) work-list) ratios)))))

(define (step-2 ratios work-list domestic)
  (let lp ((work-list work-list) (try-again '()) (converted? #f) (ratios ratios))
    (define (can-convert? c) (assq c ratios))
    ;; (pk 'ratios ratios 'work-list work-list 'converted? converted?)
    (match work-list
      (() (if converted?
              (lp try-again '() #f ratios)
              (step-3 ratios domestic)))
      ((((? can-convert? curr1) (? can-convert? curr2) amt1 amt2) . rest)
       (let* ((ratios (new-ratios ratios curr2 amt2 (to-domestic ratios curr1 amt1)))
              (ratios (new-ratios ratios curr1 amt1 (to-domestic ratios curr2 amt2))))
         (lp rest try-again #t ratios)))
      ((((? can-convert? curr1) curr2 amt1 amt2) . rest)
       (lp rest try-again #t
           (new-ratios ratios curr2 amt2 (to-domestic ratios curr1 amt1))))
      (((curr1 (? can-convert? curr2) amt1 amt2) . rest)
       (lp rest try-again #t
           (new-ratios ratios curr1 amt1 (to-domestic ratios curr2 amt2))))
      ((cannot . rest) (lp rest (cons cannot try-again) converted? ratios)))))

(define (step-3 ratios domestic)
  (for-each
   (match-lambda
     ((foreign foreign-amt domestic-amt)
      (format #t "1 ~a: ~a ~a\n" domestic foreign
              (exact->inexact (/ foreign-amt domestic-amt)))))
   ratios))

(define list-of-weights1
  '((CAD GBP  100 200)
    (GBP EUR  200 300)
    (EUR AUD  300 400)
    (AUD JPY  400 500)
    (CAD JPY  100 500)
    (RMB HKD  100 110)))

(step-1 list-of-weights 'GBP)
(step-1 list-of-weights1 'CAD)

@jralls a better one for 797806, still not quite right

What are methods ? and _ ? And what the heck does (_ _ _ (? zero?)) do?

This is mid-level scheme :)

See Gnucash/gnucash@1f83cfa#diff-ce7c9912abd1316cf68765adf6bb6e41 for a quick intro to using alex shinn's match

Answers: the following will match any pair and assign head and tail to the car and cdr. If lst is (list 1 2 3), then ...expr... will be evaluated with head = 1 and tail = (list 2 3).

(match lst
 (() ...null-expr...)
 ((head . tail) ...expr...)

The following illustrates ? and _: The 2nd match where (? zero?) is sitting where head sits, therefore head is tested via zero?. Also, the _ sits in the tail position. But doesn't get assigned. Therefore this clause is satisfied when head is zero, and the head-is-zero-expr... is evaluated. The 3rd match _ means 'anything else', therefore acts as catch-all.

(match lst
 (() null-expr...)
 (((? zero?) . _) ...head-is-zero-expr...)
 (_ ...else-expr...))

Therefore (_ _ _ (? zero?)) means we're matching any list of 4 elements whereby the 4th element is zero. e.g. (CAD USD 20 0).

In otherwords the (match lst ((_ _ _ (? zero?)) (display "4th element of list is zero."))) is identical to the following:

(cond
 ((and
   (pair? lst)
   (pair? (cdr lst))
   (pair? (cddr lst))
   (pair? (cdddr lst))
   (zero? (cdddr lst))
   (null? (cdr (cdddr lst))))
  (display "4th element of list is zero.")))

Ha! https://github.com/mpark/patterns and https://medium.com/@mcypark :)

and https://parasol.tamu.edu/~yuriys/mach7/ with stroustrup

The latest C++ proposal is P1371 and with Concepts finally (mostly) done there's a fair amount of momentum to get it into C++23. This lecture presents an interesting hack that works with C++17 to sort-of simulate pattern matching with std::variant and a couple of very simple templates. Tempting.

and https://lwn.net/Articles/845480/

and https://lwn.net/Articles/845480/

But that won't affect GnuCash, though some third-party devs might find it interesting. Looks like more of a toe in the water than jumping in at the deep end and the caveat about documentation suggests that the Pythonistas may have to wait for 3.12 before it's live. Kinda like us having to wait for C++23 to be in the old Ubuntu LTS (so 2028 or so) before we can use it, assuming it's in C++23. Unfortunately it's a language feature so there won't be any advance implementation (like boost) that we can use sooner.

No effect upon gnucash at all... Wished to highlight that pattern matching becoming mainstream whereas lisp had it for quite a while...