A Little Multi-Radix Programming Fun

I was sucked in by today's Programming Praxis Challenge: Pounds, Shillings, Pence. The goal was to create a couple math functions that worked with mixed radix values (for example, time which is specified in weeks, days, hours, minutes and seconds). Developing the API turned out to be some good fun. The exercise definitely reminded me of my very early days of programming, where you'd be given an assignment to make proper change (damn you pesky quarters, nickles and dimes!) and would have to div and mod your way to a solution. I recall being thoroughly stumped by these sort of tasks, so perhaps this was my way of slaying a very old dragon?

I ended up taking a page from Unix, and built my 'system' on the notion of converting multi-radix values to a single integer value. In the time example above, I convert all values to seconds (just like Unix does) to allow for easy math.

You could hardly call what I put together elegant, but I'm pleased with the results. It almost lets you think about the values you'd like to (in the case below, miles, yards, feet and inches) versus what the computer ideally works in.

(define dist '(1760 3 12)); read: (yards-per-mile feet-per-yard inches-per-foot)

(define short    (make-mr dist '(5))          ; 5 inches
(define football (make-mr dist '(100 0 0))    ; 100 yards
(define marathon (make-mr dist '(26 385 0 0)) ; 1 marathon

(show (mr-add football marathon))
(show (mr-sub marathon football))
...

And here's the complete code:

;; Mixed Radix Math --
;; http://programmingpraxis.com/2015/04/07/pounds-shillings-pence/
;;

(define time-spec '(7 24 60 60))
(define dist-spec '(1760 3 12))
(define hms-spec '(60 60))
  
(define (mr-factors spec)
 (let loop ((spec (reverse spec)) (current 1) (result '(1)))
  (cond ((null? spec) result)
        (else
         (let ((x (* (car spec) current)))
          (loop (cdr spec) x (cons x result)))))))

(define (mr-normalize spec value)
 (cond ((= (length value) (+ (length spec) 1)) value)
       ((> (length value) (+ (length spec) 1))
        (error "Invalid value: " value spec))
       (else
        (mr-normalize spec (append (list 0) value)))))

(define (mr->int spec value)
 (let ((factors (mr-factors spec))
       (cleaned (mr-normalize spec value)))
  (apply + (map * factors cleaned))))
  
 (define (int->mr spec value)
  (let loop ((value value) (factors (mr-factors spec)) (mr '()))
   (cond ((null? factors) (reverse mr))
         (else
          (let* ((f (car factors))
                 (q (quotient value f))
                 (r (remainder value f)))
           (loop r (cdr factors) (cons q mr)))))))

(define (show . x)
 (for-each display x)
 (newline))

;;
;; Slightly higher level API
;;

(define (make-mr spec value)
 (cons spec value))

(define (mr-spec x) (car x))
 
(define (mr-value x) (cdr x))

 
(define (mr-op op)
 (lambda (x y)
   (let ((xv (mr->int (mr-spec x) (mr-value x)))
         (yv (mr->int (mr-spec y) (mr-value y))))
     (make-mr (mr-spec x) (int->mr (mr-spec x) (op xv yv))))))
   
(define mr-add (mr-op +))
(define mr-sub (mr-op -))

 
(define x (make-mr hms-spec '(3 19 45)))