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

Merge branch 'readtable' into multiple-systems

Conflicts:
	physical-quantities/physical-quantities.lisp
	tests/physical-quantities-grid.lisp
parents f8606e64 d2a15a39
;; Antik system definition
;; Liam Healy 2010-12-24 09:43:28EST antik.asd
;; Time-stamp: <2014-07-16 11:45:49EDT antik-base.asd>
;; Time-stamp: <2014-11-27 16:38:38EST antik-base.asd>
;; Copyright 2011, 2012, 2013, 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -27,7 +27,7 @@
:license "GPL v3"
:serial t
:defsystem-depends-on (#:asdf-system-connections)
:depends-on (#:iterate #:alexandria #:metabang-bind)
:depends-on (#:iterate #:alexandria #:metabang-bind #:named-readtables)
:components
((:module init
:serial t
......@@ -42,7 +42,8 @@
(:module input-output
:serial t
:components
((:file "parameters")
((:file "readtable")
(:file "parameters")
(:file "format-output")
(:file "float")
(:file "matlab")
......
;; Mathematics on timepoints.
;; Liam Healy Fri Oct 12 2001 - 16:32
;; Time-stamp: <2013-03-24 19:33:27EDT dtmath.lisp>
;; Time-stamp: <2014-10-06 23:10:23EDT dtmath.lisp>
;; Copyright 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -83,7 +83,8 @@
"Julian Day from J2000 epoch, and seconds from the start of the day."
(values
;; Days from J2000 epoch to the start of the UTC day; always integer + 0.5.
(cl:- (days- datime #d2000-01-01T12:00:00) 1/2)
(cl:- (days- datime (MAKE-TIMEPOINT :TIMEPARSE '(0 0 12 1 1 2000) :DAY-ONLY NIL :SCALE :UTC))
1/2)
;; Seconds from the start of the UTC day to the current timepoint.
;; No timescale is required because this is
;; only a difference from the start of the day.
......
;; Read timepoint specifications.
;; Liam Healy, Sat Feb 4 2006 - 12:17
;; Time-stamp: <2014-01-05 18:06:36EST read-time.lisp>
;; Time-stamp: <2014-11-27 16:44:26EST read-time.lisp>
;; Copyright 2011, 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -298,21 +298,22 @@
(read-timepoint string '(2 0 1 3 4 5)))))
|#
;;; Read timepoint with reader macro, e.g. #d1999-03-30T12:33:45.
;;; Is there any way to get this on additional listeners?
(set-dispatch-macro-character
#\# #\d
(lambda (stream subchar arg)
(declare (ignore subchar arg))
(let* ((string
(defun read-datime (stream subchar arg)
(declare (ignore subchar arg))
(let* ((string
(stream-to-string
stream
:terminate-if
(lambda (ch)
(not (or (alphanumericp ch)
(member ch '(#\: #\- #\.) :test #'char-equal)))))))
(unless *read-suppress*
(read-time string)))))
(unless *read-suppress*
(read-time string))))
;;; Read timepoint with reader macro, e.g. #d1999-03-30T12:33:45.
;;; Is there any way to get this on additional listeners?
(set-dispatch-macro-character
#\# #\d 'read-datime
(named-readtables:find-readtable :antik))
(defparameter *prehistoric* (read-timepoint "1900-01-01T00:00:00"))
;; Tests for date-time
;; Liam Healy 2014-01-13 22:00:52EST tests.lisp
;; Time-stamp: <2014-01-14 21:16:56EST time-interval-tests.lisp>
;; Time-stamp: <2014-12-26 15:37:08EST time-interval-tests.lisp>
;; Copyright 2011, 2013, 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -19,6 +19,7 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :antik)
(named-readtables:in-readtable :antik)
;;;****************************************************************************
;;; Tests
......
;; Time interval parsing and generating.
;; Liam Healy Thu May 2 2002 - 16:34
;; Time-stamp: <2014-01-14 21:21:06EST time-interval.lisp>
;; Time-stamp: <2014-10-06 22:37:13EDT time-interval.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -97,8 +97,7 @@
"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.")
nil = with the unit for time given by :system-of-units.")
(defun time-interval-format (pq &optional (stream t))
"Format the time interval ISO8601."
......
;; Functions on grids
;; Liam Healy 2010-06-19 22:25:17EDT functions.lisp
;; Time-stamp: <2014-01-05 14:40:50EST functions.lisp>
;; Time-stamp: <2014-11-27 16:57:53EST functions.lisp>
;; Copyright 2010, 2011, 2012, 2013, 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -201,10 +201,7 @@
(defvar *row-separator* '^)
(export *row-separator*)
;;; Use #m to make the foreign-array
(set-dispatch-macro-character
#\# #\m
(lambda (stream subchar arg)
(defun read-grid (stream subchar arg)
(declare (ignore subchar))
(read-char stream)
(let ((list (read-delimited-list #\) stream)))
......@@ -217,8 +214,12 @@
:initial-contents
(if (find *row-separator* list)
(split-sequence:split-sequence *row-separator* list)
list))))))
list)))))
;;; Use #m to make the foreign-array
(set-dispatch-macro-character
#\# #\m 'read-grid
(named-readtables:find-readtable :antik))
;;;;****************************************************************************
;;;; Simple math functions
......
;; Read from a table
;; Liam Healy 2010-07-06 12:32:55EDT read.lisp
;; Time-stamp: <2011-08-24 18:12:49EDT read.lisp>
;; Time-stamp: <2014-11-27 16:40:23EST read.lisp>
;;
;; Copyright 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -76,14 +76,14 @@
#|
;;;;; New approach, based on Fare-CSV reader
(defun read-grid (string)
(defun read-grid-csv (string)
(grid:make-simple-grid
:initial-contents
(antik::map-leaf
'read-from-string
(with-input-from-string (s string) (fare-csv:read-csv-stream s)))))
(read-grid
(read-grid-csv
"1.0, 1.0
2.0, 1.414213562373095
3.0, 1.732050807568877
......
;; Define a new readtable
;; Liam Healy 2014-09-28 22:27:28EDT readtable.lisp
;; Time-stamp: <2014-11-27 16:32:40EST readtable.lisp>
;; Copyright 2014 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)
(export 'antik)
(named-readtables:defreadtable :antik
(:merge :standard)
(:macro-char #\# :dispatch))
;; Least squares estimation
;; Liam Healy 2013-03-29 14:16:21EDT least-squares.lisp
;; Time-stamp: <2013-06-19 15:09:38EDT least-squares.lisp>
;; Time-stamp: <2014-12-26 15:14:02EST least-squares.lisp>
;; Copyright 2013 Liam M. Healy
;; Copyright 2013, 2014 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
......@@ -21,6 +21,7 @@
;;; This requires GSLL
(in-package :antik)
(named-readtables:in-readtable :antik)
(export '(linear-least-squares-1d))
......
;; Angles by component parts.
;; Liam Healy Thu May 30 2002 - 11:46
;; Time-stamp: <2013-03-24 19:01:15EDT angle-component.lisp>
;; Time-stamp: <2014-10-06 22:29:48EDT angle-component.lisp>
;; Copyright 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -312,7 +312,7 @@
;;; (let ((asin (asin sine)))
;;; (if (minusp vertical-halfplane) (- pi asin) (if (minusp asin) (+ 2pi asin) asin)))
(defparameter *half-rev* #_1/2_revolution)
(defparameter *half-rev* (make-pq 1/2 'revolution))
(defmethod pq-magnitude :before ((angle angle))
;; I'm undecided on whether to use antik:atan etc. here vs. atan;
......
;; Functions on angles
;; Liam Healy Fri Mar 26 1999 - 13:48
;; Time-stamp: <2013-12-16 17:48:14EST angle.lisp>
;; Time-stamp: <2015-01-01 13:20:21EST angle.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Copyright 2011, 2013, 2014 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
......@@ -81,7 +81,7 @@
(defun angle-as-time (angle &optional (normalize t))
"Convert the angle to a time (interval), where one revolution is a
complete day."
(antik:* #_1_day/revolution
(antik:* (make-pq 1 'day/revolution)
(normalize-angle angle normalize)))
(defvar *check-angle-limits* t
......@@ -113,7 +113,7 @@
(cl:/ (cl:abs minutes) +minutes-per-hour+)
(cl:/ (cl:abs seconds) +seconds-per-hour+)))))
(if hours
(antik:* (make-pq decimal 'hours) #_1_revolution/day)
(antik:* (make-pq decimal 'hours) (make-pq 1.0 'revolution/day))
(make-pq decimal 'degree))))
(defun time-as-angle (time-string)
......
;; Objects that represent physical measurements.
;; Liam Healy Wed Mar 6 2002 - 09:04
;; Time-stamp: <2014-11-05 11:30:50EST physical-quantities.lisp>
;; Time-stamp: <2015-01-01 12:19:05EST physical-quantities.lisp>
;; Copyright 2011, 2012, 2013, 2014 Liam M. Healy
;; Copyright 2011, 2012, 2013, 2014, 2015 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
......@@ -317,22 +317,25 @@
(defun scalar-units-p (units)
(ignore-errors (parse-units units)))
(defun read-physical-dimension-quantity (stream subchar arg)
"Read the physical dimension quantity from the stream."
(declare (ignore subchar arg))
(let ((*zero-is-dimensionless* nil)
numerical-value units)
;; Tell the reader to read the things
(setf numerical-value (stream-to-string stream :terminator #\_)
units (read stream t nil t))
;; Make the PDQ if reading is not suppressed
(unless *read-suppress*
(make-pq
(read-from-string numerical-value)
units
(scalar-units-p units)))))
;;; Use #_ for physical dimension quantities, e.g. #_90_degree
(set-dispatch-macro-character
#\# #\_
(lambda (stream subchar arg)
(declare (ignore subchar arg))
(let ((*zero-is-dimensionless* nil)
numerical-value units)
;; Tell the reader to read the things
(setf numerical-value (stream-to-string stream :terminator #\_)
units (read stream t nil t))
;; Make the PDQ if reading is not suppressed
(unless *read-suppress*
(make-pq
(read-from-string numerical-value)
units
(scalar-units-p units))))))
#\# #\_ 'read-physical-dimension-quantity
(named-readtables:find-readtable :antik))
(defmethod creation-form ((pq physical-quantity))
(multiple-value-bind (mag units)
......
;; Do calculations without physical dimension.
;; Liam Healy Wed Jun 22 2005 - 22:35
;; Time-stamp: <2013-06-02 23:13:22EDT undimension.lisp>
;; Time-stamp: <2014-10-06 22:32:24EDT undimension.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -25,14 +25,14 @@
#+example
(without-units ()
(multiple-value-bind (mag inpunits) (pqwu #_4_km)
(multiple-value-bind (mag inpunits) (pqwu (make-pq 4 'km))
(redimension (g+ mag 5) inpunits)))
;;; #_9.000000000000000_km
#+example
(without-units ()
(multiple-value-bind (mag inpunits)
(pqwu (list #_4_km/s #_5_km #_6_km))
(pqwu (list (make-pq 4 'km/s) (make-pq 5 'km) (make-pq 6 'km)))
(redimension (g+ mag (list 5 10 15)) inpunits)))
;;; (#_9.000000000000000_km/s #_15.000000000000000_km #_21.000000000000000_km)
......
;; Tests of physical quantities
;; Liam Healy 2011-01-09 17:38:41EST tests.lisp
;; Time-stamp: <2014-11-05 09:12:12EST physical-quantities-grid.lisp>
;; Time-stamp: <2015-01-01 12:17:55EST physical-quantities-grid.lisp>
;; Copyright 2011, 2013, 2014 Liam M. Healy
;; Copyright 2011, 2013, 2014, 2015 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
......@@ -19,20 +19,21 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :antik)
(named-readtables:in-readtable :antik)
;;; These are all scalar units, i.e., the same units apply to each
;;; element of the array.
(lisp-unit:define-test grid-scalar-units
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid #(#_1.0d0_m #_5.0d0_m)))
(let ((grid (vector (make-pq 1.0 'm) (make-pq 5.0 'm))))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
(check-pq (grid:aref grid 1) 5.0d0 'meter))))
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid (make-array '(2) :initial-contents '(#_1.0d0_m #_5.0d0_m))))
(let ((grid (make-array '(2) :initial-contents (list (make-pq 1.0 'm) (make-pq 5.0 'm)))))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
......
;; Tests of physical quantities
;; Liam Healy 2011-01-09 17:38:41EST tests.lisp
;; Time-stamp: <2013-11-23 14:41:51EST physical-quantities.lisp>
;; Time-stamp: <2014-11-27 17:31:37EST physical-quantities.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -19,6 +19,7 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :antik)
(named-readtables:in-readtable :antik)
(defmethod lisp-unit:numerical-equal
((result1 physical-quantity) (result2 physical-quantity) &rest keys &key test)
......
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