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

Complete changes for system of units specification

- Fix number of arguments in calls to functions that no longer take
  sysunits or addition-units arguments.
- Change nf-option so that it works dynamically, i.e., the default
  value is retrieved at run time, not macro expansion time.
- Name argument to parameter-value must be in the keyword package.
- The system of units can be nil, in which case an unreadable object
  is printed, with the sexp for the dimensions printed.  
- New variable *basis-physical-dimensions* used to give the dimension
  without units.
- All nf definitions in a separate file.

System now compiles and loads without error.
parent 6ca09dfb
;; Antik system definition
;; Liam Healy 2010-12-24 09:43:28EST antik.asd
;; Time-stamp: <2013-03-23 19:22:31EDT antik.asd>
;; Time-stamp: <2013-03-24 18:32:30EDT antik.asd>
;; Copyright 2010, 2011, 2012, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -97,57 +97,31 @@
(:file "vector-matrix" :depends-on ("element-types" "subclass"))
(:file "methods" :depends-on ("foreign-array" "vector-matrix"))))
(:module physical-quantities
:serial t
:depends-on (init input-output)
:components
((:file "units")
(:file "scalar" :depends-on ("units"))
(:file "grid" :depends-on ("scalar"))
(:file "funcall" :depends-on ("scalar"))
(:file "unit-definitions" :depends-on ("units" "grid" "funcall"))
(:file "sysunit-definitions"
:depends-on ("units" "unit-definitions"))
(:file "physical-quantities" :depends-on ("units" "scalar" "sysunit-definitions"))
(:file "undimension" :depends-on ("physical-quantities"))
(:file "arithmetic" :depends-on ("units" "undimension"))
((:file "format-output")
(:file "units")
(:file "scalar")
(:file "grid")
(:file "funcall")
(:file "unit-definitions")
(:file "sysunit-definitions")
(:file "physical-quantities")
(:file "undimension")
(:file "arithmetic")
(:file "iso8601")
(:file "dtspec" :depends-on ("iso8601"))
(:file "time-interval"
:depends-on
("sysunit-definitions" "physical-quantities" "iso8601" "dtspec"))
(:file "angle"
:depends-on
;; Dependency to force loading of everything needed
;; to put #_1_unit into source code.
("physical-quantities" ; needs split-sequence
"arithmetic"
"undimension"
"unit-definitions"
"sysunit-definitions" "dtspec" "time-interval"))
(:file "angle-component"
:depends-on
("physical-quantities"
"undimension"
"unit-definitions"
"sysunit-definitions"))
(:file "state" :depends-on ("units"))
(:file "timepoint"
:depends-on
("unit-definitions"
"sysunit-definitions"
"physical-quantities" "arithmetic"
"dtspec" "iso8601" "time-interval"))
(:file "relative-time" :depends-on ("timepoint"))
(:file "read-time" :depends-on ("timepoint"))
(:file "formats" :depends-on ("read-time"))
(:file "convert-timescale"
;; Dependency to force loading of everything needed ;
;; to put #_1_unit into source code. ;
:depends-on
("physical-quantities" ; needs split-sequence ;
"arithmetic" "undimension" "unit-definitions"
"sysunit-definitions" "time-interval" "timepoint" "read-time"))
(:file "dtmath"
:depends-on ("dtspec" "read-time" "timepoint" "convert-timescale"))))
(:file "dtspec")
(:file "time-interval")
(:file "angle")
(:file "angle-component")
(:file "state")
(:file "timepoint")
(:file "relative-time")
(:file "read-time")
(:file "formats")
(:file "convert-timescale")
(:file "dtmath")))
(:module mathematics
:serial t
:components
......
;; Functions on grids
;; Liam Healy 2010-06-19 22:25:17EDT functions.lisp
;; Time-stamp: <2012-11-24 15:46:32EST functions.lisp>
;; Time-stamp: <2013-03-24 19:40:00EDT functions.lisp>
;; Copyright 2010, 2011, 2012 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -118,7 +118,7 @@
(defun make-grid
(specification &rest keys &key
(initial-contents nil initial-contents-p)
(initial-element nil initial-element-p)
(initial-element nil)
&allow-other-keys)
"Make a grid object with no or literal values specified.
The specification is of the form
......
;; Floating point numbers.
;; Liam Healy Wed May 8 2002 - 10:47
;; Time-stamp: <2012-03-10 19:25:57EST float.lisp>
;; Time-stamp: <2013-03-24 18:11:47EDT float.lisp>
;; Copyright 2011, 2012 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -230,11 +230,11 @@
(format-float
object
:significant-figures
(if (nf-option full-precision) nil (nf-option significant-figures))
(if (nf-option :full-precision) nil (nf-option :significant-figures))
:fracpart-digits
(if (nf-option full-precision) nil (nf-option fracpart-digits))
:intpart-digits (nf-option intpart-digits)
:print-sign (nf-option print-sign))))
(if (nf-option :full-precision) nil (nf-option :fracpart-digits))
:intpart-digits (nf-option :intpart-digits)
:print-sign (nf-option :print-sign))))
(values
(case (nf-option :style)
(:tex
......
;; Format numerical output
;; Liam Healy Wed Dec 11 2002 - 16:37
;; Time-stamp: <2013-02-02 10:03:43EST format-output.lisp>
;; Time-stamp: <2013-03-24 18:52:25EDT format-output.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -62,7 +62,7 @@
,@body))
(define-symbol-macro texstyle
(and (eq (nf-option style) :tex)))
(and (eq (nf-option :style) :tex)))
;;;;****************************************************************************
;;;; General nf
......@@ -112,8 +112,8 @@
(defmethod nf
((object integer) &optional (stream *standard-output*))
(format stream "~vd"
(or (nf-option significant-figures)
(nf-option intpart-digits))
(or (nf-option :significant-figures)
(nf-option :intpart-digits))
object))
(defmethod nf ((number ratio) &optional (stream *standard-output*))
......@@ -157,7 +157,7 @@
(defun vector-component-names (i)
"The name of the ith vector component."
(let ((source (nf-option components)))
(let ((source (nf-option :components)))
(elt source (mod i (length source)))))
(defmethod nf ((object sequence) &optional (stream *standard-output*))
......@@ -216,8 +216,8 @@
(defun parenstyle (outer)
"Parentheses should be used in this case."
(and outer
(or (member (nf-option style) '(:readable))
(numberp (nf-option style)))))
(or (member (nf-option :style) '(:readable))
(numberp (nf-option :style)))))
(defun nf-matrix (object &optional (stream *standard-output*))
"Format the two dimensional grid, or the one dimensional grid horizontally or vertically."
......
;; Global/local parameters to pass to functions
;; Liam Healy Sat Apr 30 2005 - 21:12
;; Time-stamp: <2013-02-17 23:00:49HST parameters.lisp>
;; Time-stamp: <2013-03-24 15:40:53EDT parameters.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -21,8 +21,7 @@
(in-package :antik)
(export '(define-parameter-category
parameter-value parameter-value*
set-parameter-value set-parameters
parameter-value set-parameter-value set-parameters
with-parameters define-parameter parameter-help
parameters-set reset-parameters
make-parameters-from-table))
......@@ -145,21 +144,10 @@ Type is: STRING, default value is "hi".
(list ',symbol)
,symbol nil)))))
(defmacro parameter-value
(category name &optional (default (default-value category name)))
(defmacro parameter-value (category name)
"Get or set the parameter value."
(parameter-access (category symbol)
`(getf ,symbol ,(alexandria:make-keyword name) ',default)))
;;; Could replace parameter-value with this?
(defmacro parameter-value*
(category name &optional default)
"Get the parameter value dynamically."
(let ((nsym (gensym)))
(parameter-access (category symbol)
`(let ((,nsym ,name))
(getf ,symbol ,nsym
(or ,default (default-value ',category ,nsym)))))))
`(getf ,symbol ,(alexandria:make-keyword name) (default-value ,category ,name))))
(defmacro set-parameter-value* (category name value)
"Set the parameter value without checking."
......
;; Angles by component parts.
;; Liam Healy Thu May 30 2002 - 11:46
;; Time-stamp: <2011-08-03 10:58:49AKDT angle-component.lisp>
;; Time-stamp: <2013-03-24 19:01:15EDT angle-component.lisp>
;; Copyright 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -347,9 +347,9 @@
(antik:- *half-rev* asin) ; result between pi/2, 3pi/2
asin))) ; result between -pi/2, pi/2
(t (error "Insufficient information to find angle.")))))
(setf magnitude
(pqval (antik:+ normalized
(make-pq whole-revolutions 'revolution)) nil *siu*)))))
(setf
magnitude
(pqval (antik:+ normalized (make-pq whole-revolutions 'revolution)))))))
(defun magnitude-or-nil (angle)
(ignore-errors (pq-magnitude angle)))
......@@ -382,7 +382,7 @@
(change-class angle 'angle))
(with-angle angle
(multiple-value-bind (norm revs)
(normalize-angle (pqval angle 'radian) positive)
(normalize-angle (pq-magnitude angle) positive)
(setf whole-revolutions revs
normalized (make-pq norm 'radian))
(values norm revs)))))
......@@ -398,7 +398,7 @@
;; an angle object, so change it.
(change-class angle 'angle))
(multiple-value-bind (norm revs)
(normalize-angle (pqval angle 'radian) positive)
(normalize-angle (pq-magnitude angle) positive)
(values (make-pq norm 'radian) revs))))
angle))
......
;; Functions on angles
;; Liam Healy Fri Mar 26 1999 - 13:48
;; Time-stamp: <2013-03-23 19:12:42EDT angle.lisp>
;; Time-stamp: <2013-03-24 19:22:39EDT angle.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -18,6 +18,8 @@
;; 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)
(setf *radian* (make-pq 1 'radian))
(export '(norm-denorm-angle angle-as-time dms-angle time-as-angle angle-dms write-dms))
......@@ -122,7 +124,7 @@
"The angle as a list degrees, minutes, seconds."
(let ((*print-circle* nil))
(multiple-value-bind (degrees dfrac)
(cl:floor (pqval (antik:abs angle) 'degree *siu*))
(cl:floor (with-system-of-units (degree) (pqval (antik:abs angle))))
(multiple-value-bind (mins mfrac)
(cl:floor (cl:* 60 dfrac))
(list
......
;; Mathematics on timepoints.
;; Liam Healy Fri Oct 12 2001 - 16:32
;; Time-stamp: <2011-12-02 12:30:19EST dtmath.lisp>
;; Time-stamp: <2013-03-24 19:33:27EDT dtmath.lisp>
;; Copyright 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -76,9 +76,8 @@
;;; (seconds-per-day #d1998-12-31) -> 86401
(defun seconds-per-day (datime)
"Compute the number of seconds in the given day."
(pqval
(datime- (start-of-day datime 1) (start-of-day datime))
'second))
(pq-magnitude
(datime- (start-of-day datime 1) (start-of-day datime))))
(defun datime-J2000day (datime)
"Julian Day from J2000 epoch, and seconds from the start of the day."
......@@ -115,7 +114,7 @@
(cl:+ (timepoint-J2000sec tp)
(if (numberp time)
time
(pqval time 'second)))
(pq-magnitude time)))
(day-only tp)))))
;;; N.B.:
......
;; Specification and formatting of datimes.
;; Liam Healy Fri Oct 12 2001 - 10:04
;; Time-stamp: <2013-03-17 23:14:48EDT dtspec.lisp>
;; Time-stamp: <2013-03-24 18:51:52EDT dtspec.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -216,30 +216,20 @@
;;; Numerica format
;;;****************************************************************************
(define-parameter nf :ignore-day-only
nil t
"Datime specified day-only will still format with time.")
(define-parameter nf :date-time-separator
nil (or null character (member t))
;; Interpretation of nil, t determined by #'iso8601-string.
"Character to place between date and time in ISO8601 datime output.
If nil, use a space, if T, use #\T.")
(defmethod nf
((object dtspec) &optional (stream *standard-output*))
(format stream "~@[~a~]~a"
(when (nf-readably) "#d")
(if (and (day-only object) (not (nf-option ignore-day-only)))
(if (and (day-only object) (not (nf-option :ignore-day-only)))
(subseq (iso8601 object) 0 10)
(iso8601-string
(timeparse object)
nil
(if (nf-readably)
nil
(or (nf-option fracpart-digits)
(or (nf-option :fracpart-digits)
*iso8601-fractional-seconds-digits*))
(or (nf-option date-time-separator)
(or (nf-option :date-time-separator)
(when (nf-readably) T))))))
;;;****************************************************************************
......
;; Parameters for nf related to physical quanitites.
;; Liam Healy 2013-03-24 18:24:56EDT format-output.lisp
;; Time-stamp: <2013-03-24 18:27:00EDT format-output.lisp>
;; Copyright 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
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; 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)
(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.")
(define-parameter nf :timepoint-linear
nil (or symbol list)
"Convert timepoints to a linear scale if
specified as a list of epoch time and unit. For example
\computer{'(*midnight-2000* :year)} will present time points as a
real number of calendar years, including fractions, such as
3.3223. If the value is a symbol representing a unit, like :year,
the epoch is taken as 0.")
(define-parameter nf :ignore-day-only
nil t
"Datime specified day-only will still format with time.")
(define-parameter nf :date-time-separator
nil (or null character (member t))
;; Interpretation of nil, t determined by #'iso8601-string.
"Character to place between date and time in ISO8601 datime output.
If nil, use a space, if T, use #\T.")
(define-parameter nf :degrees
:decimal (member :decimal :dms)
"Whether to format degrees as decimal degees or degrees, minutes, seconds.")
(define-parameter nf :time
:tud (or null (member :tud :alternate))
"How to format time intervals:
:tud = ISO8601 time-unit designator (like P10H7M23.726979085813582S)
:alternative = ISO8601 alternate (like P10:07:23.726979085813582)
nil = with the unit for time given by :system-of-units
(like #_36443.72697908581_S.")
;; Datime formats, compatibility with non-iso8601.
;; Liam Healy Fri Oct 12 2001 - 16:27
;; Time-stamp: <2013-02-24 16:20:30EST formats.lisp>
;; Time-stamp: <2013-03-24 19:36:00EDT formats.lisp>
;; Copyright 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -32,10 +32,12 @@
(sy-dtspec (copy-list tp)))
(setf (timeparse-month sy-dtspec) 1 (timeparse-day sy-dtspec) 1)
(let ((yearstart (make-dtspec :timeparse sy-dtspec)))
(values (cl:+ 1 (days- datime yearstart)
;; doy is counted starting from 1, not 0.
(pqval (antik:- datime (start-of-day datime)) 'day))
(timeparse-year (timeparse datime))))))
(values
(cl:+ 1 (days- datime yearstart)
;; doy is counted starting from 1, not 0.
(with-system-of-units (day)
(pqval (antik:- datime (start-of-day datime)))))
(timeparse-year (timeparse datime))))))
(defun to-yyddd (datime)
"Generate the twoline element form of datime. Note this
......@@ -106,7 +108,7 @@
(loop for year from start-year to end-year
do
(format t
(case format
(ecase format
(:csv ", ~d")
(:org "| ~d")
(:tex "& ~d"))
......@@ -115,7 +117,7 @@
(loop for month from 1 to 12
do
(format t
(case format
(ecase format
(:csv "~& ~a")
(:org "~&| ~a")
(:tex "\\\\ ~& ~a "))
......@@ -123,7 +125,7 @@
(loop for year from start-year to end-year
do
(format t
(case format
(ecase format
(:csv ", ~d")
(:org "| ~d")
(:tex " & $~d$"))
......@@ -144,8 +146,9 @@
(defun linear-timepoint
(timepoint &optional (reference-point *midnight-2000*) (unit :year))
"Compute the timepoint on a linear (number) scale."
(cl:+ (pqval (antik:- timepoint reference-point) unit)
(if (eq unit :year)
(timeparse-part (timeparse reference-point) unit)
0)))
(cl:+ (with-system-of-units* (unit)
(pqval (antik:- timepoint reference-point)))
(if (eq unit :year)
(timeparse-part (timeparse reference-point) unit)
0)))
;; Objects that represent physical measurements.
;; Liam Healy Wed Mar 6 2002 - 09:04
;; Time-stamp: <2013-03-23 18:58:40EDT physical-quantities.lisp>
;; Time-stamp: <2013-03-24 20:48:50EDT physical-quantities.lisp>
;; Copyright 2011, 2012, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -150,18 +150,6 @@
;;;; Extracting values and printing
;;;;****************************************************************************
(define-parameter nf :degrees
:decimal (member :decimal :dms)
"Whether to format degrees as decimal degees or degrees, minutes, seconds.")
(define-parameter nf :time
:tud (or null (member :tud :alternate))
"How to format time intervals:
:tud = ISO8601 time-unit designator (like P10H7M23.726979085813582S)
:alternative = ISO8601 alternate (like P10:07:23.726979085813582)
nil = with the unit for time given by :system-of-units
(like #_36443.72697908581_S.")
(defmethod nf
((pq physical-quantity) &optional (stream *standard-output*))
(if (and (grid:gridp pq)
......@@ -172,37 +160,41 @@
(call-next-method)
(multiple-value-bind (val units)
(pqval pq)
(if (and (nf-option time)
(if (and (nf-option :time)
(not (grid:gridp (pq-magnitude pq)))
(check-dimension pq 'time nil nil))
(progn
(unless texstyle (when (nf-readably) (princ "#d" stream)))
(princn (iso8601-time-interval pq (nf-option time))
(princn (iso8601-time-interval pq (nf-option :time))
stream))
(if (nf-option system-of-units)
(if (nf-option :system-of-units)
(format-units val units (scalar-dimension pq) stream)
(nf val stream)))))) ; format the number only
(defmethod print-object ((pq physical-quantity) stream)
"Print the physical-quantity using nf."
#+debug
(print-unreadable-object (pq stream)
(format stream "Physical dimension quantity [debug] mag ~a"
(pq-magnitude pq)))
#-debug
(if (let ((dim (pq-dimension pq)))
(and dim (arrayp dim) (null (row-major-aref dim 0))))
;; units not set yet
(print-unreadable-object (pq stream)
(format stream "Physical dimension quantity mag ~a, unspecified units"
(pq-magnitude pq)))
(cl-readable-nf (nf pq stream))))
"Print the physical-quantity using nf."
#+debug
(print-unreadable-object (pq stream)
(format stream "Physical dimension quantity [debug] mag ~a"
(pq-magnitude pq)))
#-debug
(let ((dim (pq-dimension pq)))
(if (or (null (nf-option :system-of-units))
(and dim (arrayp dim) (null (row-major-aref dim 0))))
;; units not set yet
(print-unreadable-object (pq stream)
(format stream "Physical dimension quantity mag ~a, dimensions ~a"
(pq-magnitude pq)
(when dim
(with-system-of-units*
(*basis-physical-dimensions*)
(make-unit-sexp dim t)))))
(cl-readable-nf (nf pq stream)))))
(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)
(declare (ignore units-or-system))
(values pq nil nil)))
(defmethod pqval ((pq physical-quantity))
......@@ -284,18 +276,18 @@
(format
stream "\\unitfrac~@[[~a]~]{~a}{~a}"
(when value (nf-string value))
(make-pq-string (second units) (nf-option style))
(make-pq-string (third units) (nf-option style)))
(if (and (eq (nf-option degrees) :dms) (eq units 'degree))
(make-pq-string (second units) (nf-option :style))
(make-pq-string (third units) (nf-option :style)))
(if (and (eq (nf-option :degrees) :dms) (eq units 'degree))
(format-dms value stream)
(format
stream
(if (eq units 'degree) "~@[~a~]~a" "\\unit~@[[~a]~]{~a}")
(when value (nf-string value))
(make-pq-string units (nf-option style))))))
(make-pq-string units (nf-option :style))))))
;; Plain style
(if scalar-dimension
(if (and (eq (nf-option degrees) :dms) (eq units 'degree))
(if (and (eq (nf-option :degrees) :dms) (eq units 'degree))
(format-dms value stream)
(format stream
(if (nf-readably) "~@[#_~a_~]~a" "~@[~a~]~a")
......@@ -346,7 +338,6 @@
(make-pq
(read-from-string numerical-value)
units
nil
(scalar-units-p units))))))
(defmethod creation-form ((pq physical-quantity))
......
;; Physical attributes that describe (or partially describe) a physical state.
;; Liam Healy Mon Apr 1 2002 - 16:27
;; Time-stamp: <2013-03-21 22:11:41EDT state.lisp>
;; Time-stamp: <2013-03-24 19:36:25EDT state.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -113,7 +113,7 @@
;; ignore-errors so that non-attributes
;; like 'timepoint will pass
(ignore-errors
(find-unit-expr (dimension name) (nf-option :system-of-units)))))
(find-unit-expr (dimension name)))))
(when (and include-units expr)
(with-output-to-string (stream)
(format-units nil expr t stream)))))))
......@@ -132,10 +132,10 @@
;; TeX print name of attribute
(tex-print-name name)
;; plain print name
(if (or (eq (nf-option style) :short)
(and (typep (nf-option style) 'fixnum)
(if (or (eq (nf-option :style) :short)
(and (typep (nf-option :style