Commit 6ca09dfb authored by Liam M. Healy's avatar Liam M. Healy
Browse files

System of units specification is through an nf-option

The specification of the system-of-units is through an nf-option, and
no longer passed as arguments to functions.  Systems of units (with or
without augmented units) are made via make-sysunits or
define-system-of-units, set-default-system-of-units that call it.

This does not compile.
parent be3fc5a5
;; Antik system definition
;; Liam Healy 2010-12-24 09:43:28EST antik.asd
;; Time-stamp: <2013-03-21 22:22:30EDT antik.asd>
;; Time-stamp: <2013-03-23 19:22:31EDT antik.asd>
;; Copyright 2010, 2011, 2012, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -102,7 +102,7 @@
((:file "units")
(:file "scalar" :depends-on ("units"))
(:file "grid" :depends-on ("scalar"))
(:file "funcall")
(:file "funcall" :depends-on ("scalar"))
(:file "unit-definitions" :depends-on ("units" "grid" "funcall"))
(:file "sysunit-definitions"
:depends-on ("units" "unit-definitions"))
......
......@@ -1274,13 +1274,13 @@ For units defined by Antik, see the source file @file{antik/physical-quantities/
@node Systems of units, , Dimensions, Physical dimension
@subsection Systems of units
A @dfn{system of units} is a set of units, one for each of the physical dimensions that Antik can handle. A system of units is needed by Antik for printing output and in special cases for converting physical quantities that have a physical dimension defined (e.g. length), but no units. The system of units defined by
@code{*system-of-units*} is used to determine the units in which the output is printed. There are pre-defined several systems of units, @code{*siu*}, @code{*englishu*}, @code{*cgsu*}:
@code{(nf-option :system-of-units)} is used to determine the units in which the output is printed. There are pre-defined several systems of units, @code{*siu*}, @code{*englishu*}, @code{*cgsu*}:
@example
ANTIK-USER> (defparameter *length1* #_10_m)
*LENGTH1*
ANTIK-USER> *length1*
#_10.000000000000000_m
ANTIK-USER> (setf *system-of-units* *englishu*)
ANTIK-USER> (set-default-system-of-units *englishu*)
(((1 0 0 0 0 0 0 0 0) . FOOT) ((0 0 0 0 0 0 0 0 1) . RADIAN)
((0 0 1 0 0 0 0 0 0) . SLUG) ((0 1 0 0 0 0 0 0 0) . SECOND)
((1 -2 1 0 0 0 0 0 0) . POUND-FORCE) ((2 -3 1 0 0 0 0 0 0) . HORSEPOWER)
......@@ -1291,10 +1291,10 @@ ANTIK-USER> *length1*
@end example
So by setting the system of units, you can convert values as needed,
@example
ANTIK-USER> (setf *system-of-units* *siu*)
ANTIK-USER> (set-default-system-of-units *siu*)
ANTIK-USER> #_12_feet
#_3.657600000000000d0_m
ANTIK-USER> (setf *system-of-units* *englishu*)
ANTIK-USER> (set-default-system-of-units *englishu*)
ANTIK-USER> #_3_m
#_9.842519685039370d0_ft
@end example
......
;; Functions on angles
;; Liam Healy Fri Mar 26 1999 - 13:48
;; Time-stamp: <2013-03-18 22:46:40EDT angle.lisp>
;; Time-stamp: <2013-03-23 19:12:42EDT angle.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -18,18 +18,9 @@
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :antik)
(export '(norm-denorm-angle angle-as-time dms-angle time-as-angle angle-dms write-dms angle-degrees))
;;; Use degrees in the current system of units.
(setsys angle-degrees nil degree)
(setf *radian* (make-pq 1 'radian))
;;;;****************************************************************************
;;;; Angle relations
;;;;****************************************************************************
(export '(norm-denorm-angle angle-as-time dms-angle time-as-angle angle-dms write-dms))
;;; This will be obsolete
(defun norm-denorm-angle (angle function &optional positive)
......@@ -46,8 +37,8 @@
;;; other angle.
(defmacro angle-find
(&key sine-angle cosine-angle
sign-sine-angle sign-cosine-angle
angle-clone)
sign-sine-angle sign-cosine-angle
angle-clone)
"Find the angle, with accurate quadrant, from just about anything.
Returns a value between -pi and pi.
sine-angle: The sine of the angle
......@@ -70,6 +61,10 @@
`(cl:atan (sign (cl:sin ,angle-clone)) ,cosine-angle))
(t (error "Can't determine angle from information given."))))
;;;;****************************************************************************
;;;; Angle relations
;;;;****************************************************************************
;;; To print an angle as time in the conventional hh:mm:ss.sss
;;; (setf *time-print-format* 3)
;;; (angle-as-time (sidereal-time now #_-77_deg))
......
;; Grid methods for physical dimension quantities
;; Liam Healy 2011-01-17 18:36:54EST grid.lisp
;; Time-stamp: <2011-10-02 14:16:44EDT grid.lisp>
;; Time-stamp: <2013-03-23 18:54:21EDT grid.lisp>
;; Copyright 2011 Liam M. Healy
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -58,8 +58,7 @@
(t (list :initial-element nil)))))
(not (not same-units)))))
(defun make-pq-grid
(magnitude unit-expressions &optional (sysunits *system-of-units*))
(defun make-pq-grid (magnitude unit-expressions)
"Make a physical dimension quantity out of a grid where the elements may have different units. This may modify the contents of the magnitude grid."
;; We make a scalar pdq out of each element in order to compute the
;; SI value of the magnitude before making the pdq object.
......@@ -71,7 +70,7 @@
:element-type t
:initial-contents unit-expressions))
for i below (grid:total-size magnitude)
for pq-elt = (make-pq-ue (grid:aref* magnitude i) (grid:aref* ue i) sysunits)
for pq-elt = (make-pq-ue (grid:aref* magnitude i) (grid:aref* ue i))
do
(setf (grid:aref* magnitude i) (pq-magnitude pq-elt)
(grid:aref* unit-array i) (pq-dimension pq-elt))
......
;; Objects that represent physical measurements.
;; Liam Healy Wed Mar 6 2002 - 09:04
;; Time-stamp: <2013-03-21 22:34:43EDT physical-quantities.lisp>
;; Time-stamp: <2013-03-23 18:58:40EDT physical-quantities.lisp>
;; Copyright 2011, 2012 Liam M. Healy
;; Copyright 2011, 2012, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -32,10 +32,9 @@
;;; All return
;;; (1 -2 2 0 0 0 0 0 0)
;;; 1.0
(defun parse-units (unit-expression &optional (sysunits *system-of-units*))
"Find the dimel representation of the dimensions from a
string, symbol, or unit sexp."
(parse-unit-sexp (find-unit-expr (parse-pq-string unit-expression) sysunits)))
(defun parse-units (unit-expression)
"Find the dimel representation of the dimensions from a string, symbol, or unit sexp."
(parse-unit-sexp (find-unit-expr (parse-pq-string unit-expression))))
;;; (parse-pq-string "m-kg^2/s^2")
;;; (/ (* M KG KG) (* S S))
......@@ -151,10 +150,6 @@
;;;; Extracting values and printing
;;;;****************************************************************************
(define-parameter nf :system-of-units
*siu* list
"The system of units used for output. If NIL, don't print units. Standard systems of units may be altered with #'augment-sysunits.")
(define-parameter nf :degrees
:decimal (member :decimal :dms)
"Whether to format degrees as decimal degees or degrees, minutes, seconds.")
......@@ -203,47 +198,46 @@
(pq-magnitude pq)))
(cl-readable-nf (nf pq stream))))
(defgeneric pqval (pq &rest sysunits-additional-units)
(defgeneric pqval (pq)
(:documentation
"Get the numerical value and the units of the physical dimension quantity. Returns the magnitude, the units, and whether units are the same for each element of a sequence or grid.")
(:method (pq &rest sysunits-additional-units)
(declare (ignore sysunits-additional-units))
(:method (pq)
(declare (ignore units-or-system))
(values pq nil nil)))
(defmethod pqval ((pq physical-quantity) &rest sysunits-additional-units)
(defmethod pqval ((pq physical-quantity))
(let ((units
(make-unit-sexp
(pq-dimension pq)
(apply #'augment-sysunits sysunits-additional-units)
(scalar-dimension pq))))
(make-unit-sexp
(pq-dimension pq)
(scalar-dimension pq))))
(if (scalar-dimension pq)
(values
(antik:/ (pq-magnitude pq) (nth-value 1 (parse-unit-sexp units)))
units
t)
(antik:/ (pq-magnitude pq) (nth-value 1 (parse-unit-sexp units)))
units
t)
;; Grid dimensions
;;(funcall (grid:elementwise ))
(loop with newmag = (grid:copy-to (pq-magnitude pq) (grid:gridp (pq-magnitude pq)))
with newdim = (grid:copy-to (pq-dimension pq) 'array)
for i from 0 below (grid:total-size pq)
do
(multiple-value-bind (mag dim)
(pqval (grid:aref* pq i))
(setf (grid:aref* newmag i) mag
(grid:aref* newdim i) dim))
(multiple-value-bind (mag dim)
(pqval (grid:aref* pq i))
(setf (grid:aref* newmag i) mag
(grid:aref* newdim i) dim))
finally (return (values newmag newdim nil))))))
(defparameter *pqval-allsame-sequence-collapse* t
"If a sequence passed to pqval has all the same units,
collapse to one unit specification.")
(defmethod pqval ((pq sequence) &rest sysunits-additional-units)
(defmethod pqval ((pq sequence))
(let ((mat
(transpose-list
(map 'list
(lambda (x)
(multiple-value-list
(apply #'pqval x sysunits-additional-units)))
(pqval x)))
pq))))
(multiple-value-bind (allsame-val allsame-same)
(all-same (second mat) :test #'equal) ; all same units
......@@ -256,8 +250,7 @@
(let ((removed-zeros (remove-if 'zerop pq)))
(when (< (length removed-zeros) (length pq))
(multiple-value-bind (ignore units asnz)
(apply
#'pqval removed-zeros sysunits-additional-units)
(pqval removed-zeros)
(declare (ignore ignore))
(when asnz units))))))
(as (and *pqval-allsame-sequence-collapse*
......@@ -270,9 +263,9 @@
(second mat))
as)))))
(defun pqval-seq (pq &rest sysunits-additional-units)
(defun pqval-seq (pq)
(let ((*pqval-allsame-sequence-collapse* nil))
(apply #'pqval pq sysunits-additional-units)))
(pqval pq)))
;;;;****************************************************************************
;;;; Interface
......@@ -317,7 +310,7 @@
(make-pq-string (grid:aref units i))))))))
(defmacro with-pq (physical-quantities &body body)
"Ensure that the named physical dimension quantities are of the right dimensions, or convert them from plain numbers using the current system of units as specified by *system-of-units*."
"Ensure that the named physical dimension quantities are of the right dimensions, or convert them from plain numbers using the current system of units as specified by (nf-option :system-of-units)."
;; should I have the option to return plain numbers
;; in some system of units as well?
`(let ,(mapcar
......@@ -327,7 +320,7 @@
physical-quantities)
,@body))
(defun read-pq-from-string (string units &optional sysunits)
(defun read-pq-from-string (string units)
"Read the next number and interpret as a pdq, if units is non-nil.
The special 'pointer gives the starting location to read
and is updated after the read."
......@@ -336,7 +329,7 @@
(read-from-string
string nil nil :start (if (boundp 'pointer) pointer 0))
(setf pointer ptr)
(if units (make-pq mag units sysunits) mag)))
(if units (make-pq mag units) mag)))
;;; Use #_ for physical dimension quantities, e.g. #_90_degree
(set-dispatch-macro-character
......
;; Physical dimension quantity with a magnitude that is a scalar
;; Liam Healy 2011-01-01 12:05:37EST grid.lisp
;; Time-stamp: <2011-10-08 18:00:07EDT scalar.lisp>
;; Time-stamp: <2013-03-23 18:55:13EDT scalar.lisp>
;; Copyright 2011 Liam M. Healy
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -84,15 +84,12 @@
;;; (make-pq 5 'speed)
;;; #_5.0_KM/S
(defun make-pq
(magnitude unit-expression
&optional (sysunits *system-of-units*) (scalar-dimension t))
(defun make-pq (magnitude unit-expression &optional (scalar-dimension t))
"Make a physical dimension quantity (PDQ). Allow for the
possiblity that magnitude is already a PDQ; in this case, check
that the physical dimension is correct, and pass it on. This can
be used as a way of assigning default units to a number. If
sysunits is specified, unitless dimensions (e.g., 'length) are
interpeted as units in that system. If scalar-dimension is T and
be used as a way of assigning default units to a number. Unitless dimensions (e.g., 'length) are
interpeted as units in the :system-of-units. If scalar-dimension is T and
magnitude is not a scalar, the unit-expression applies to each
element of the magnitude. Otherwise it must be a grid or list of
the shape as the magnitude."
......@@ -101,12 +98,12 @@
(check-dimension magnitude unit-expression))
magnitude
(let ((mag
;; If the magnitude has pdq elements (i.e., array), take them out.
;; Note, unlike above, no consistency check is made.
(if (grid:gridp magnitude)
(funcall (grid:elementwise (alexandria:rcurry #'pqval sysunits))
magnitude)
magnitude)))
;; If the magnitude has pdq elements (i.e., array), take them out.
;; Note, unlike above, no consistency check is made.
(if (grid:gridp magnitude)
(funcall (grid:elementwise #'pqval)
magnitude)
magnitude)))
(if (and (grid:gridp mag) (not scalar-dimension))
(make-pq-grid
mag
......@@ -115,14 +112,13 @@
(make-array
(grid:dimensions unit-expression)
:element-type t
:initial-contents unit-expression))
sysunits)
(make-pq-ue mag unit-expression sysunits)))))
:initial-contents unit-expression)))
(make-pq-ue mag unit-expression)))))
(defun make-pq-zero (unit-expression &optional (sysunits *system-of-units*))
(let ((*zero-is-dimensionless* nil)) (make-pq 0 unit-expression sysunits)))
(defun make-pq-zero (unit-expression)
(let ((*zero-is-dimensionless* nil)) (make-pq 0 unit-expression)))
(defun make-pq-ue (magnitude unit-expression sysunits)
(defun make-pq-ue (magnitude unit-expression)
"Make the physical dimension quantity with a unit expression from a number or grid; if a grid, the same units apply to all elements."
#+debug
(check-type
......@@ -134,7 +130,7 @@
(not unit-expression))
magnitude
(multiple-value-bind (dimel convfact)
(parse-units unit-expression sysunits)
(parse-units unit-expression)
(if (equal dimel (dimension 'dimensionless))
magnitude
(if convfact
......
;; Definitions of systems of units
;; Liam Healy Tue Mar 19 2002 - 18:07
;; Time-stamp: <2011-06-05 23:37:14EDT sysunit-definitions.lisp>
;; Time-stamp: <2013-03-23 18:05:17EDT sysunit-definitions.lisp>
;; Copyright 2011 Liam M. Healy
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -25,24 +25,21 @@
;;; The file unit-definitions must be compiled and loaded before this can
;;; be compiled.
(define-sysunits *siu*
(define-system-of-units *siu*
(meter second kilogram kelvin
ampere mole candela radian
newton watt joule pascal coulomb volt
farad ohm siemens tesla weber henry)
nil
"Systeme internationale system of units.")
(define-sysunits *cgsu*
(define-system-of-units *cgsu*
(centimeter radian gram second dyne watt erg dynes-per-square-centimeter)
nil
"The CGS system of units.")
(define-sysunits *englishu*
(define-system-of-units *englishu*
(foot radian slug second pound-force
horsepower foot-pound pounds-per-square-inch)
nil
"The English system of units.")
(setf *system-of-units* *siu*) ; Default default system of units is SI
(setsys si *siu*) ; so 'si will set si as default system
(make-set-system-of-units-symbol si *siu*) ; so 'si will set si as default system
si
;; Time interval parsing and generating.
;; Liam Healy Thu May 2 2002 - 16:34
;; Time-stamp: <2013-03-21 22:55:40EDT time-interval.lisp>
;; Time-stamp: <2013-03-23 18:15:39EDT time-interval.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -22,7 +22,7 @@
(in-package :antik)
(export '(timeparse-time-interval iso8601-time-interval time-interval-timeparse iso8601-parse-time-interval all-time-units))
(export '(timeparse-time-interval iso8601-time-interval time-interval-timeparse iso8601-parse-time-interval))
;;; Output
(defun timeparse-time-interval
......@@ -102,12 +102,3 @@
(piti "2Y8M16DT6H14M22S") ; 2 years, 8 months, ...
(piti "0002-08-16T06:14:22")))) ; 2 years, 8 months, ...
(defparameter *all-time-units* '(day hour minute second))
(defun all-time-units (time-interval &optional (stream *standard-output*))
"Show the time interval in all possible time units."
(dolist (tu *all-time-units*)
(with-nf-options (:system-of-units (augment-sysunits (list tu)))
(nf time-interval (list tu) stream))
(fresh-line stream))
time-interval)
;; Do calculations without physical dimension.
;; Liam Healy Wed Jun 22 2005 - 22:35
;; Time-stamp: <2011-08-03 10:52:43AKDT undimension.lisp>
;; Time-stamp: <2013-03-23 18:57:35EDT undimension.lisp>
;; Copyright 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -48,7 +48,7 @@
(list ,@args))))
(defmacro without-units
((&optional (system-of-units '*system-of-units*)) &body body)
((&optional (system-of-units '(nf-option :system-of-units))) &body body)
"Compute everything within the dynamic scope without physical units.
Physical dimension quantities should be wrapped with #'pqwu."
`(let ((*remove-units-sysunits* ,system-of-units))
......@@ -72,9 +72,8 @@
(defun redimension (magnitude unit-expression)
"Apply units that were stripped off a quantity."
(let ((sysunits *remove-units-sysunits*) ; should be unnecessary
(*remove-units-sysunits* nil))
(make-pq magnitude unit-expression sysunits T)))
(let ((*remove-units-sysunits* nil))
(make-pq magnitude unit-expression T)))
;;; Generalize to multiple value returns?
(defmacro dimensionless-call (function answer-dimension &rest arguments)
......
;; Define physical dimensions and units of measure and systems of units.
;; Liam Healy Wed Feb 27 2002 - 13:18
;; Time-stamp: <2013-03-21 22:48:46EDT units.lisp>
;; Time-stamp: <2013-03-23 19:16:24EDT units.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -23,9 +23,11 @@
(export '(dimension
get-canonical-name print-name
long-print-name short-print-name tex-print-name
*system-of-units* define-sysunits define-unit define-units
define-system-of-units define-unit define-units
define-physical-constant
set-default-sysunits setsys dimensionless))
set-default-system-of-units
reset-system-of-units
make-set-system-of-units-symbol dimensionless))
;;; Handle physical dimensions and units of measure, for any
;;; units scaling type (simple ratio).
......@@ -101,9 +103,9 @@
;;;; Defining systems of units
;;;;****************************************************************************
(defparameter *system-of-units* nil
;; Actual value defined in sysunit-definitions.lisp
"Default system of units used by pqval.")
(define-parameter nf :system-of-units
nil list
"The system of units used for output. If NIL, don't print units. Standard systems of units may be altered with #'make-sysunits.")
(defun sysunitsp (thing)
"This is possibly a system of units."
......@@ -151,7 +153,7 @@
;;; (FIND-UNITS '(-2 1 1 0 0 0 0 0 0) si)
;;; (METER -2 (0 1 1 0 0 0 0 0 0))
;;; This does not handle mixed units predictably; see 2002-09-04.
(defun find-units (dimel sysunits)
(defun find-units (dimel)
"Find a minimal combination of named units in the designated system of units
that matches the dimel. Returns a list (unit-name exponent remainder-dimel)."
(if (equal (dimension 'dimensionless) dimel)
......@@ -161,7 +163,7 @@
;; Throw away all named units whose magnitude is greater than
;; the dimel we have.
(remove-if (lambda (n) (> n (dimel-magnitude dimel)))
sysunits
(nf-option :system-of-units)
:key #'sysunits-metric)
'cl:>
:key #'sysunits-metric))
......@@ -180,49 +182,43 @@
(setf best-rem rem best-rem-mag (dimel-magnitude rem)
best-div div best-unit unit))))))))
(defun augment-sysunits (&rest sysunits-additional-units)
"Augment the system of units with individual unit symbols.
The arguments are optionally one list representing a system of units,
and any number of symbols to override a unit in the system of units."
(defun make-sysunits (units-or-system)
"Make a system of units by naming the units and optionally naming a system of units which serves as a base. Argument 'units-or-system is a list of symbols naming units or a system of units. If more than one system of units is given, only the first one is used; the rest are ignored."
;; as defined by the dimel-unit alist with
;; the units given; these units will come first and will take precedence
(let ((nonils (remove nil sysunits-additional-units)))
(let ((nonils (remove nil units-or-system)))
(append (mapcar
(lambda (u)
(check-type u symbol)
(let ((cu (get-canonical-name u)))
(cons (dimension cu) cu)))
(remove-if-not #'symbolp nonils))
(remove-if #'sysunitsp (remove-if-not #'symbolp nonils)))
(or (find-if #'sysunitsp nonils)
;;(nf-option :system-of-units)
*system-of-units*
))))
(nf-option :system-of-units)))))
(defmacro define-sysunits (system-name units &optional base-sysunits docstring)
"Make a system of units with the given name and units, optionally
agumenting the existing system of units base-sysunits."
(defmacro define-system-of-units (system-name units-or-system docstring)
"Make a system of units with the given name and units."
`(defparameter ,system-name
(apply #'augment-sysunits ,base-sysunits ',units)
(make-sysunits ',units-or-system)
,docstring))
(defun set-default-sysunits (sysunits &rest additional-units)
"Set the default system of units to the specified system,
possibly augmenting it with other units. additional-units
may be NIL to augment the current default system."
(setf *system-of-units*
(if (first additional-units)
(apply #'augment-sysunits
(or sysunits *system-of-units*) additional-units)
sysunits))
(format t "~&Set default system of units.")
(defun set-default-system-of-units (&rest units-or-system)
"Set the default system of units to the specified system."
(setf
(parameter-default (find-parameter :nf :system-of-units))
(make-sysunits (append units-or-system (list (nf-option :system-of-units)))))
(warn "Set default system of units.")
(reset-system-of-units)
(values))
(defmacro setsys (symbol sysunits &rest additional-units)
"Set the symbol macro symbol to make the system of units sysunits default.
additional-units may be \useform{NIL} to augment the current default system."
(defun reset-system-of-units ()
"Reset the system of units to the default."
(reset-parameters :nf :system-of-units))
(defmacro make-set-system-of-units-symbol (symbol &rest units-or-system)
"Set the symbol macro symbol to make the system of units."
`(define-symbol-macro
,symbol
(apply #'set-default-sysunits ,sysunits ',additional-units)))
(set-default-system-of-units ,@units-or-system)))
;;;;****************************************************************************
;;;; Parsing and generating dimensions and units
......@@ -354,20 +350,20 @@
;;; (make-ue '(2 -4 3 0 0 0 0 0 0) siu)
;;; (NEWTON 2 KILOGRAM 1)
;;; (make-ue '(1/2 0 0 0 0 0 0 0 0) siu)
(defun make-ue (dimel sysunits)
(defun make-ue (dimel)
"From the dimel (list of dimension exponents),
make an unit-exponent list."
(check-dimel dimel)
(multiple-value-bind (dimelint cd)
(rationalize-units dimel)
(destructuring-bind (unit expon remainder)
(find-units dimelint sysunits)
(find-units dimelint)
(if (eq unit 'unity)
nil
(if (equal remainder dimelint)
(error "Dimensions cannot be interpreted in this system of units.")
(append (list unit (/ expon cd))
(make-ue (/ remainder cd) sysunits)))))))
(make-ue (/ remainder cd))))))))
;;; This is the inverse of parse-unit-sexp
;;; (make-unit-sexp '(2 -4 3 0 0 0 0 0 0) siu)
......@@ -375,7 +371,7 @@
;;; (make-unit-sexp '(-2 1 1 0 0 0 0 0 0) siu)
;;; (/ (* KILOGRAM SECOND) (EXPT METER 2))
;;; (make-unit-sexp '(1/2 0 0 0 0 0 0 0 0) siu)
(defun make-unit-sexp (dimel sysunits scalar-dimensions)
(defun make-unit-sexp (dimel scalar-dimensions)
"From the dimel (list of dimension exponents),
make an unit sexp."
(if scalar-dimensions
......@@ -386,7 +382,7 @@
(pwr (name expon) (if (= expon 1) name `(expt ,name ,expon))))
(when dimel
(check-dimel dimel)
(loop for (unit expon) on (make-ue dimel sysunits) by #'cddr
(loop for (unit expon) on (make-ue dimel) by #'cddr
when (plusp expon)
collect (pwr unit expon) into num
when (minusp expon)
......@@ -396,20 +392,18 @@
(if (null den)
(prod num)
`(/ ,(if (null num) 1 (prod num)) ,(prod den)))))))
(let ((fn (grid:elementwise (alexandria:rcurry #'make-unit-sexp sysunits t))))
(let ((fn (grid:elementwise (alexandria:rcurry #'make-unit-sexp t))))
(funcall fn dimel))))