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

Systems of units names in the units table

Systems of units are no longer dynamic variables or setting default
systems symbol macros. Instead, the systems' names are placed in the table
with unit names, *unit-information*.
parent 2a22903a
;; Datime formats, compatibility with non-iso8601.
;; Liam Healy Fri Oct 12 2001 - 16:27
;; Time-stamp: <2013-03-24 19:36:00EDT formats.lisp>
;; Time-stamp: <2013-06-02 23:11:06EDT formats.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
......@@ -146,7 +146,7 @@
(defun linear-timepoint
(timepoint &optional (reference-point *midnight-2000*) (unit :year))
"Compute the timepoint on a linear (number) scale."
(cl:+ (with-system-of-units* (unit)
(cl:+ (with-nf-options (:system-of-units (make-sysunits (list unit) t))
(pqval (antik:- timepoint reference-point)))
(if (eq unit :year)
(timeparse-part (timeparse reference-point) unit)
......
;; Objects that represent physical measurements.
;; Liam Healy Wed Mar 6 2002 - 09:04
;; Time-stamp: <2013-04-14 10:00:32EDT physical-quantities.lisp>
;; Time-stamp: <2013-06-02 13:48:46EDT physical-quantities.lisp>
;; Copyright 2011, 2012, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -186,8 +186,8 @@
(format stream "Physical dimension quantity mag ~a, dimensions ~a"
(pq-magnitude pq)
(when dim
(with-system-of-units*
(*basis-physical-dimensions*)
(with-system-of-units
(basis-physical-dimensions)
(make-unit-sexp dim t)))))
(cl-readable-nf (nf pq stream)))))
......
;; Definitions of systems of units
;; Liam Healy Tue Mar 19 2002 - 18:07
;; Time-stamp: <2013-03-24 20:39:47EDT sysunit-definitions.lisp>
;; Time-stamp: <2013-06-02 23:12:38EDT sysunit-definitions.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -20,31 +20,27 @@
(in-package :antik)
(export '(si *siu* *englishu* *cgsu*))
;;; The file unit-definitions must be compiled and loaded before this can
;;; be compiled.
(define-system-of-units *siu*
;;; "Systeme internationale system of units."
(define-system-of-units si
(meter second kilogram kelvin
ampere mole candela radian
newton watt joule pascal coulomb volt
farad ohm siemens tesla weber henry)
"Systeme internationale system of units.")
farad ohm siemens tesla weber henry))
(define-system-of-units *cgsu*
(centimeter radian gram second dyne watt erg dynes-per-square-centimeter)
"The CGS system of units.")
;;; "The centimeter-gram-seconds system of units."
(define-system-of-units cgs
(centimeter radian gram second dyne watt erg dynes-per-square-centimeter))
(define-system-of-units *englishu*
;;; "The English system of units."
(define-system-of-units english
(foot radian slug second pound-force
horsepower foot-pound pounds-per-square-inch)
"The English system of units.")
horsepower foot-pound pounds-per-square-inch))
(make-set-system-of-units-symbol si *siu*) ; so 'si will set si as default system
si
;;; "A pseudo-system of units with dimension names for formatting units; it cannot be used for conversions."
(setf (find-sysunits 'basis-physical-dimensions)
(make-sysunits *basis-dimensions*))
;;; This is made as a system of units, though it only works for formatting units, it cannot do conversions.
(defparameter *basis-physical-dimensions*
(make-sysunits *basis-dimensions* nil)
"A pseudo-system of units with dimension names.")
(set-system-of-units 'si)
;; Do calculations without physical dimension.
;; Liam Healy Wed Jun 22 2005 - 22:35
;; Time-stamp: <2013-03-24 19:37:55EDT undimension.lisp>
;; Time-stamp: <2013-06-02 23:13:22EDT undimension.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
......@@ -67,7 +67,9 @@
If not, return the object as-is."
(if *remove-units-sysunits*
(let ((*pqval-allsame-sequence-collapse* nil))
(with-system-of-units* (*remove-units-sysunits*) (pqval pq)))
(with-nf-options (:system-of-units
(make-sysunits nil *remove-units-sysunits*))
(pqval pq)))
(values pq nil nil)))
(defun redimension (magnitude unit-expression)
......
;; Define physical dimensions and units of measure and systems of units.
;; Liam Healy Wed Feb 27 2002 - 13:18
;; Time-stamp: <2013-06-01 09:49:55EDT units.lisp>
;; Time-stamp: <2013-06-02 23:19:36EDT units.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -23,14 +23,12 @@
(export '(dimension
get-canonical-name print-name
long-print-name short-print-name tex-print-name
define-system-of-units define-derived-system-of-units
define-unit define-units
define-physical-constant
set-default-system-of-units
make-set-system-of-units-symbol
with-system-of-units
with-system-of-units*
with-si-units
with-units ; add units to current system of units within scope
with-system-of-units ; new system of units within scope
set-system-of-units ; set system of units
define-system-of-units
dimensionless))
;;; Handle physical dimensions and units of measure, for any
......@@ -104,13 +102,9 @@
(format nil "\\text{~a}" (short-print-name unit))))
;;;;****************************************************************************
;;;; Defining systems of units
;;;; Find units from a system of units
;;;;****************************************************************************
(defun sysunitsp (thing)
"This is possibly a system of units."
(and (listp thing) (listp (first thing))))
(defun sysunits-dimel (x) (first x))
(defun sysunits-unitname (x) (rest x))
......@@ -182,60 +176,54 @@
(setf best-rem rem best-rem-mag (dimel-magnitude rem)
best-div div best-unit unit))))))))
(defun make-sysunits (units-or-system &optional (augment-current t))
"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 units-or-system)))
(append (mapcar
(lambda (u)
(let ((cu (get-canonical-name u)))
(cons (dimension cu) cu)))
(remove-if #'sysunitsp (remove-if-not #'symbolp nonils)))
(or (find-if #'sysunitsp nonils)
(when augment-current (nf-option :system-of-units))))))
(defmacro define-system-of-units (system-name units-or-system &optional docstring)
"Make a system of units with the given name and units."
`(defparameter ,system-name
(make-sysunits ',units-or-system nil)
,docstring))
(defmacro define-derived-system-of-units
(system-name units-or-system base-system &optional docstring)
"Make a system of units with the given name and units."
`(defparameter ,system-name
(make-sysunits (append ',units-or-system (list ,base-system)) nil)
,docstring))
(defun set-default-system-of-units (&rest units-or-system)
;;;;****************************************************************************
;;;; Set system of units
;;;;****************************************************************************
;; with-units ; add units to current system of units within scope
;; with-system-of-units ; new system of units within scope
;; set-system-of-units ; set system of units
;; define-system-of-units
(defun find-unit-dimel (symbol)
(let ((cu (get-canonical-name symbol)))
(cons (dimension cu) cu)))
(defmacro find-sysunits (sysunits)
"Find the named system of units."
`(unit-property ,sysunits 'system-of-units))
(defun make-sysunits (units &optional system-of-units)
"Make a system of units by naming the units and optionally naming a system of units which serves as a base; if it is T, then use the current system-of-units."
;; Put an 'equal remove-duplicates on 'first to make a clean list of dimels.
(append (mapcar 'find-unit-dimel units)
(if (eq system-of-units t)
(nf-option :system-of-units)
(when system-of-units
(find-sysunits system-of-units)))))
(defmacro define-system-of-units (system-name units &optional derived-from)
"Define a system of units with the given name and units, possibly derived from a named system of units."
`(setf (find-sysunits ',system-name) (make-sysunits ',units ',derived-from)))
(defun set-system-of-units (system-of-units &rest units)
"Set the default system of units to the specified system."
(setf
(parameter-value :nf :system-of-units)
(make-sysunits (append units-or-system (list (nf-option :system-of-units)))))
(warn "Set default system of units.")
(nf-option :system-of-units)
(make-sysunits units system-of-units))
;;(warn "Set default system of units.")
(values))
(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
(set-default-system-of-units ,@units-or-system)))
(defmacro with-system-of-units ((&rest units) &body body)
"When executing the body, change the system of units by naming the units. Arguments 'units-or-system are symbols naming units and augment the defined system of units."
(defmacro with-system-of-units ((system-of-units &rest units) &body body)
"When executing the body, change the system of units by naming the units. If system-of-units is non-nil, augment that system with the specified units; if it is T, augment the current system of units."
;; Eventually, it would be nice to be able to take systems too, but it's awkward with symbol-value and checking sysunitp etc.
`(with-nf-options (:system-of-units (make-sysunits ',units))
,@body))
(defmacro with-system-of-units* ((&rest units-or-system) &body body)
"When executing the body, use a system of units by naming the units and optionally naming a system of units which serves as a base. Arguments 'units-or-system are 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. Arguments will be evaluated; names of units must be quoted."
`(with-nf-options (:system-of-units (make-sysunits ,(cons 'list units-or-system)))
`(with-nf-options
(:system-of-units (make-sysunits ',units ',system-of-units))
,@body))
(defmacro with-si-units (&body body)
"Use the SI system of units in the body."
`(with-system-of-units* (*siu*) ,@body))
`(with-system-of-units (si) ,@body))
;;;;****************************************************************************
;;;; Parsing and generating dimensions and units
......
;; Tests of physical quantities
;; Liam Healy 2011-01-09 17:38:41EST tests.lisp
;; Time-stamp: <2013-04-30 22:41:52EDT physical-quantities.lisp>
;; Time-stamp: <2013-06-02 13:52:03EDT physical-quantities.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -48,17 +48,16 @@
(lisp-unit:assert-numerical-equal #_3600_s #_1_hour))
(lisp-unit:define-test system-of-units
(lisp-unit::assert-numerical-equal
10.0d0
(with-system-of-units (degree) (pqval #_10_degrees)))
(lisp-unit::assert-numerical-equal
10.0d0
(with-system-of-units (t degree) (pqval #_10_degrees)))
(lisp-unit::assert-numerical-equal
0.3048d0
(antik::pq-magnitude
(with-system-of-units* (*englishu*) (make-pq 1 'length))))
(with-system-of-units (english) (make-pq 1 'length))))
(lisp-unit::assert-numerical-equal
100000.0d0
(let ((sysunits (nf-option :system-of-units)))
(set-default-system-of-units *cgsu*)
(with-system-of-units (cgs)
(prog1
(pqval #_1_km)
(set-nf-options :system-of-units sysunits)))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment