lisp/convert.lisp
2024-12-16 14:34:52 -05:00

69 lines
1.9 KiB
Common Lisp

(load "utils.lisp")
(ql:quickload "fset")
(named-readtables:in-readtable fset:fset-readtable)
;; TODO: compound
;; let's do the form :cm :cm :cm first
(defparameter conv
'((:kg (1000 :g))
(:g (1000 :mg))
(:m (100 :cm))
(:km (1000 :m))
(:in (254/100 :cm))
(:ft (12 :in))
(:yd (3 :ft))
(:mi (1760 :yd))
(:ml (1 :cm :cm :cm))
(:hz (1 (:s -1)))
(:acre (4840 (:yd 2)))))
(defparameter dims
'(((:time) :fs :ps :ns :ms :cs :s :ks :gs :min :hr :day :yr :century :millennium)
((:length) :fm :pm :nm :mm :cm :m :km :gm :in :ft :yd :mi)
((:mass) :fg :pg :ng :mg :cg :g :kg :gg :lb)
((:length 2) :acre)
((:time -1) :hz)))
;; multiset is not sufficient!
;; why did i not read this comment!
(defun dim (&rest dims)
(let1 out (fset:with-default #{| |} 0)
(loop for (dim . rest) on dims
when (keywordp dim)
do (incf (fset:@ out dim)
(if (aand (car rest)
(numberp it))
(car rest)
1)))
out))
;; maybe should memoize?
;; hash-table would be ffffast
;; eh dw
(defun convs (from)
(loop for (a (n b)) in conv
when (eq a from)
collect `(,n ,b)
when (eq b from)
collect `(,(/ n) ,a)))
(defun convert (n from to &optional past)
(cond1
(equal from to) n
(consp from) (cond1
(atom to) :idk
(longer from to) nil
;; OMG
(apply #'*
(mapcar (lambda (f to)
(convert n f to (cons from past)))
from to)))
(let1 convs (remove-if #'(lambda (x) (member (cadr x) past :test #'equal)) (convs from))
(if convs
(loop for (mul new-from) in convs
do (let1 got (convert (* n mul) new-from to (cons from past))
(if got (return got))))
nil))))