It turns out that it is not uncommon that I use these, so I wrote a newLISP module which helps the newLISP programmer to make and use them. Here are usage examples.
Code: Select all
> (load "mixed-radix.lsp")
MAIN
> (mixed-radix:new HHMMSS (hours minutes seconds) (1 60 60))
HHMMSS
> (HHMMSS:to-minutes '(3 34 42))
214.7
> (HHMMSS:to-seconds '(3 34 42))
12882
> (HHMMSS:from-minutes 214.7)
(3 34 42)
> (HHMMSS:from-seconds 12882)
(3 34 42)
> (HHMMSS:+ '(3 34 42) '(1 54 59))
(5 29 41)
When the following is loaded in newLISP
Code: Select all
;;--------------------------------------
;; Application: Floor plan lengths
(load "mixed-radix.lsp")
(mixed-radix:new ftin (feet inches) (1 12))
(define rawdims '((laundry ((5 5) (2 11) (4 6.5))
((7 1.5)))
(bath ((4 10.5))
((7 1)))
(family-room ((10 4.5) (8 11.5) (0 1))
((12 1) (10 0) (0 1)))))
(define (dim<-rawdim rawdim)
(list (rawdim 0)
(apply ftin:add (rawdim 1))
(apply ftin:add (rawdim 2))))
(define dims (map dim<-rawdim rawdims))
(define (sqft<-dim dim)
(list (dim 0)
(mul (ftin:to-feet (dim 1))
(ftin:to-feet (dim 2)))))
;; Show and tell.
(println "Dimensions:")
(println dims)
(define sqftages (map sqft<-dim dims))
(println "SQ FTages:")
(println sqftages)
(println "Total SQ FT = " (apply add (map last sqftages)))
Code: Select all
Dimensions:
((laundry (12 10.5) (7 1.5)) (bath (4 10.5) (7 1)) (family-room (
19 5)
(22 2)))
SQ FTages:
((laundry 91.734375) (bath 34.53125) (family-room 430.4027778))
Total SQ FT = 556.6684028
Here is the module's code from mixed-radix.lsp. Enjoy (as Norman would say)! --Ricky
Code: Select all
;;;; mixed-radix.lsp -- Mixed radix numbers for newLISP
;;;; Author: Rick Hanson
;;;; Date: 9 June 2007
(context 'mixed-radix)
;;;-------------------------------------
;;; Slots and Constructor
(define labels '())
(define bases '())
(define-macro (mixed-radix:new mrn-symbol mrn-labels mrn-bases)
(letex (mrn-labels mrn-labels mrn-bases mrn-bases)
(MAIN:new 'mixed-radix mrn-symbol)
(let (ctx (eval mrn-symbol)
unqualify (lambda (symb) (replace ".*:" (string symb) "" 0)))
(setq ctx:labels (quote mrn-labels))
(setq ctx:bases (quote mrn-bases))
;; Setup the conversion functions for new instances.
(dolist (label ctx:labels)
(set (sym (append "to-" (unqualify label)) ctx)
(letex ($$idx $idx fsym (sym 'mid-units<-mixrad ctx))
(curry fsym $$idx)))
(set (sym (append "from-" (unqualify label)) ctx)
(letex ($$idx $idx fsym (sym 'mixrad<-mid-units ctx))
(curry fsym $$idx))))
mrn-symbol)))
;;;-------------------------------------
;;; Utilities used in this context.
(define (compose)
(apply (lambda (f g) (expand (lambda () (f (apply g (args)))) 'f 'g))
(args) 2))
(define-macro (kurry f)
(letex ($f (eval f)
$cargs (map eval (args)))
(lambda () (apply $f (append (quote $cargs) (args))))))
(define (butlast xs) (0 (- (length xs) 1) xs))
;; This version of `unfold' uses `while' and `setq' (for reasons of
;; time and space efficiency) -- "don't pay any attention to the man
;; behind the curtain!" :-)
(define (unfold p f g s post)
(let (acc '())
(while (not (p s))
(push (f s) acc -1)
(setq s (g s)))
(post p f g s acc)))
;;;-------------------------------------
;;; Method Definitions
(define (low-units<-mixrad M (bases bases))
"Convert a mixrad `M' to a scalar in low-order units with respect
to the list of bases `bases'."
(rotate bases -1)
(apply MAIN:add
(map (lambda (i) (mul (M i) (apply mul (i bases))))
(sequence 0 (- (length M) 1)))))
(define (high-units<-mixrad M (bases bases))
"Convert a mixrad `M' to a scalar in high-order units with
respect to the list of bases `bases'."
(div (low-units<-mixrad M) (apply mul bases)))
(define (mid-units<-mixrad mid M)
"Convert a mixrad `M' to a scalar in `mid'-order units with
respect to the list of bases `bases'. `mid' is zero-based. This
function acts as if the radix point of `M' were after the
`mid'-th digit (from the left). For instance to convert 3 hours,
34 minutes, 42 seconds into minutes, say
(mixed-radix:new HHMMSS (hours minutes seconds) (1 60 60))
(HHMMSS:mid-units<-mixrad 1 '(3 34 42))
which yields 214.7, as expected."
(letn (mid+1 (+ mid 1)
basesL (0 mid+1 bases)
digitsL (0 mid+1 M)
basesR (cons 1 (mid+1 bases))
digitsR (cons 0 (mid+1 M)))
(MAIN:add (low-units<-mixrad digitsL basesL)
(high-units<-mixrad digitsR basesR))))
(define (mixrad<-low-units N (bases bases))
"Convert `N', which is a scalar in low-order units, to a mixrad,
with respect to the list of bases 'bases'."
(rotate bases -1)
(unfold (lambda (s) (>= (s 1) (length bases)))
(lambda (s) (/ (s 0) (apply mul ((s 1) bases))))
(lambda (s) (list (mod (s 0) (apply mul ((s 1) bases))) (+ (s 1) 1)))
;; In the seed, keep track of the latest remainder AND an
;; incrementing index with which we use to slice `bases':
(list N 0)
;; In the post-processor, add the last remainder into the
;; last entry in the accumulated list:
(lambda (p f g s res0)
(append (butlast res0) (list (MAIN:add (s 0) (last res0)))))))
;; This is not used by any method or instance conversion function, but
;; is here for completion sake.
(define (mixrad<-high-units N (bases bases))
"Convert `N', which is a scalar in high-order units, to a mixrad,
with respect to the list of bases 'bases'."
(mixrad<-low-units (apply mul (cons N bases))))
(define (mixrad<-mid-units mid N)
"Convert `N', which is a scalar in mid-order units, to a mixrad,
with respect to the list of bases 'bases'."
(mixrad<-low-units (apply mul (cons N ((+ mid 1) bases)))))
;; Now it's easy to define a normalization function.
(define (normalize M)
"Return the canonical representation of mixrad `M' with respect to
the list of bases `bases'."
(mixrad<-low-units (low-units<-mixrad M)))
(define (component-wise-operator op) (compose normalize (kurry map op)))
(define mixed-radix:add (component-wise-operator MAIN:add))
(define mixed-radix:sub (component-wise-operator MAIN:sub))
(define mixed-radix:+ mixed-radix:add)
(define mixed-radix:- mixed-radix:sub)
(context MAIN)