Commit e31d94c7 authored by Liam Healy's avatar Liam Healy

Merge branch 'multiple-systems' into documentation

parents 9f6f3dc2 29ba9721
;; Datime formats, compatibility with non-iso8601.
;; Liam Healy Fri Oct 12 2001 - 16:27
;; Time-stamp: <2014-01-13 21:55:47EST formats.lisp>
;; Time-stamp: <2015-09-07 10:02:16EDT formats.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
......@@ -99,11 +99,11 @@
"July" "August" "September" "October" "November" "December"))
(defun jd-table (start-year end-year &optional (format :org))
"Write out a JD table in TeX, e.g. for class.
If d is the day of the month, add d+0.5 to the table
to get the J2000 day number for that day.
If csv is T, use csv for import into spread sheet.
IF nil, use TeX."
"Write out a J2000 day number table. Output format is org-mode table (:org), LaTeX (:tex), or comma-separated values (:csv)."
(when (eq format :tex)
(format t
"\\begin{tabular}{c|~a}~&"
(make-sequence 'string (1+ (- end-year start-year)) :initial-element #\c)))
(format t (case format (:org "| Month\\Year") (t " Month")))
(loop for year from start-year to end-year
do
......@@ -113,14 +113,16 @@
(:org "| ~d")
(:tex "& ~d"))
year))
(when (eq format :org) (format t "|~&|-"))
(case format
(:org (format t "|~&|-"))
(:tex (format t "\\\\ \\hline")))
(loop for month from 1 to 12
do
(format t
(ecase format
(:csv "~& ~a")
(:org "~&| ~a")
(:tex "\\\\ ~& ~a "))
(:tex (if (eq month 1) "~& ~a " "\\\\ ~& ~a ")))
(elt (if (eq format :org) *month-names-full* *month-names*) (1- month)))
(loop for year from start-year to end-year
do
......@@ -135,4 +137,5 @@
(make-timeparse-majord year month 1)
:scale :utc))
3/2)))
(when (eq format :org) (princ "|"))))
(when (eq format :org) (princ "|")))
(when (eq format :tex) (format t "~&\\end{tabular}")))
;; ISO 8601:2000(E) time and date representation
;; Liam Healy Sat Aug 7 1999 - 18:07
;; Time-stamp: <2014-01-13 22:03:16EST iso8601.lisp>
;; Time-stamp: <2015-04-25 12:32:19EDT iso8601.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -73,7 +73,8 @@
a list of numbers (second minute hour)."
(let ((ts (remove #\: (string-upcase timespec))))
(flet ((rfs (start &optional end)
(read-from-string ts nil nil :start start :end end)))
(let ((*read-default-float-format* 'double-float))
(read-from-string ts nil nil :start start :end end))))
(cond ((zerop (length ts)) (list 0 0 0))
((some #'alpha-char-p timespec)
;; "Time-unit designator" format for time intervals, Section 5.5.4.2.1
......@@ -82,13 +83,13 @@
(spos (position #\S ts)))
(list
(if spos (rfs (1+ (or mpos hpos -1)) spos) 0) ; second
(if mpos (rfs (1+ (or hpos -1)) mpos) 0) ; minute
(if hpos (rfs 0 hpos) 0)))) ; hour
(if mpos (rfs (1+ (or hpos -1)) mpos) 0) ; minute
(if hpos (rfs 0 hpos) 0)))) ; hour
(t
(list
(if (cl:> (length ts) 4) (rfs 4) 0) ; second
(if (cl:> (length ts) 4) (rfs 4) 0) ; second
(if (cl:> (length ts) 2) (rfs 2 4) 0) ; minute
(rfs 0 2))))))) ; hour
(rfs 0 2))))))) ; hour
;;; (iso8601-date-parse "2002-05-03")
;;; (3 5 2002)
......@@ -261,14 +262,16 @@
(show-datime-field format hour day month year)
(show-datime-field format minute hour day month year)
(unless (and (zerop second) (eq format :tud))
(format-float
second
:significant-figures nil
:intpart-digits (if (eq format :tud) 1 2)
:fracpart-digits
(if (numberp fractional-seconds-digits) fractional-seconds-digits)
:intpart-fill
#\0)))))
(if (integerp second)
(format nil "~2,'0d" second)
(format-float
second
:significant-figures nil
:intpart-digits (if (eq format :tud) 1 2)
:fracpart-digits
(if (numberp fractional-seconds-digits) fractional-seconds-digits)
:intpart-fill
#\0))))))
;;; It would be nice to have iso8601-string
;;; be able to generate "date only". Maybe this should be split in two,
;;; the same way parsing is?
;; Time interval parsing and generating.
;; Liam Healy Thu May 2 2002 - 16:34
;; Time-stamp: <2014-10-06 22:37:13EDT time-interval.lisp>
;; Time-stamp: <2015-04-25 13:07:07EDT time-interval.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Copyright 2011, 2013, 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
......@@ -22,7 +22,8 @@
(in-package :antik)
(export '(timeparse-time-interval iso8601-time-interval time-interval-timeparse iso8601-parse-time-interval))
(export '(timeparse-time-interval iso8601-time-interval time-precision-seconds
time-interval-timeparse iso8601-parse-time-interval))
;;;;****************************************************************************
;;;; Output
......@@ -32,16 +33,20 @@
(time &optional (fractional-seconds-digits *iso8601-fractional-seconds-digits*))
"Convert the time interval to a timeparse."
(with-pq ((time time))
(let* ((rounded-time
(let* ((timemag (pqval time))
(rounded-time
;; Use the time in seconds to the formatted precision
;; to prevent something like
;; (iso8601-time-interval #_35999.9999999998_sec :tud)
;; "PT9h59m60.000s"
(read-from-string
(format-float
(pqval (abs time))
:significant-figures nil
:fracpart-digits fractional-seconds-digits)))
(if (rationalp timemag)
(abs timemag)
(let ((*read-default-float-format* 'double-float))
(read-from-string
(format-float
(abs timemag)
:significant-figures nil
:fracpart-digits fractional-seconds-digits)))))
(tseconds rounded-time))
(multiple-value-bind
(tminutes seconds) (cl:floor tseconds +seconds-per-minute+)
......@@ -68,6 +73,12 @@
format
fractional-seconds-digits)))
(defun time-precision-seconds (time-interval &optional (float-format 'double-float))
"Approximate inaccuracy in seconds of the time interval; e.g. if 1, than the seconds digit is inaccurate."
(with-si-units
(* (pqval time-interval)
(symbol-value (alexandria:ensure-symbol (mkstr float-format "-EPSILON"))))))
;;;;****************************************************************************
;;;; Input
;;;;****************************************************************************
......
;; Format numerical output for grids and sequences
;; Liam Healy Wed Dec 11 2002 - 16:37
;; Time-stamp: <2014-01-14 22:27:36EST format-output.lisp>
;; Time-stamp: <2015-04-26 22:45:46EDT format-output.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
......@@ -97,7 +97,9 @@
"Format the one dimensional grid."
;; Note: cannot handle lists yet.
;; This is called from nf-grid, called only when :vector-format is :coordinate-unit-vectors.
(dotimes (i (grid:dim0 object))
(dotimes (i (if (numberp *print-length*)
(min *print-length* (grid:dim0 object))
(grid:dim0 object)))
;; iterate formatting each element
(with-nf-options
;; If formatting as a linear combination with element labels,
......@@ -121,7 +123,12 @@
(:coordinate-unit-vectors (vector-component-names i))
(:vertical #\newline)
(:horizontal #\space))))
stream))))
stream)))
(when (and (numberp *print-length*) (cl:> (grid:dim0 object) *print-length*))
(if texstyle
(princ "\\dots" stream)
(princ "..." stream)))
object)
(defun parenstyle (outer)
"Parentheses should be used in this case."
......@@ -137,13 +144,15 @@
(case (nf-option :vector-format)
(:vertical (grid:aref object i))
(:horizontal (grid:aref object j))))))
(let ((dim1 (or (grid:dim1 object)
(if (eq (nf-option :vector-format) :vertical)
1
(grid:dim0 object))))
(dim0 (if (or (grid:dim1 object) (eq (nf-option :vector-format) :vertical))
(grid:dim0 object)
1)))
(let* ((dim1n (or (grid:dim1 object)
(if (eq (nf-option :vector-format) :vertical)
1
(grid:dim0 object))))
(dim0n (if (or (grid:dim1 object) (eq (nf-option :vector-format) :vertical))
(grid:dim0 object)
1))
(dim0 (if (numberp *print-length*) (min dim0n *print-length*) dim0n))
(dim1 (if (numberp *print-length*) (min dim1n *print-length*) dim1n)))
(when texstyle
(format stream "\\left[\\begin{array}{~a}~&"
(if (nf-option :tex-decimal-align)
......@@ -168,6 +177,10 @@
(if texstyle
(princ (nf-option :tex-element-separator) stream)
(princ (nf-option :vertical-element-separator) stream))))
(when (and (numberp *print-length*) (or (> dim0n *print-length*) (> dim1n *print-length*)))
(if texstyle
(princ "\\dots" stream)
(princ "..." stream)))
;; close out TeX array
(when texstyle (format stream "~&\\end{array}\\right]"))
(when (parenstyle t) (princ #\) stream)))) ; close paren for whole array
......
;; Tests of grid composition functions
;; Liam Healy 2009-11-28 17:12:53EST compose.lisp
;; Time-stamp: <2013-12-28 10:22:46EST compose.lisp>
;; Time-stamp: <2015-04-25 14:52:26EDT compose.lisp>
;;
;; Copyright 2009, 2010, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -274,7 +274,7 @@
(make-grid-sequential-elements
:destination-specification '((array 3 4) double-float))
(make-grid-sequential-elements
:offset 0.5 :destination-specification '((array 2 4) double-float)))))
:offset 0.5d0 :destination-specification '((array 2 4) double-float)))))
(lisp-unit:assert-numerical-equal
'((0.5d0 1.5d0 2.5d0 3.5d0 0.1d0 1.1d0)
(10.5d0 11.5d0 12.5d0 13.5d0 10.1d0 11.1d0)
......@@ -282,9 +282,9 @@
(contents
(concatenate-grids
(make-grid-sequential-elements
:offset 0.5 :destination-specification '((array 3 4) double-float))
:offset 0.5d0 :destination-specification '((array 3 4) double-float))
(make-grid-sequential-elements
:offset 0.1 :destination-specification '((array 3 2) double-float))
:offset 0.1d0 :destination-specification '((array 3 2) double-float))
:axis 1)))
#+(or) ; not yet ready for composite grids
(lisp-unit:assert-numerical-equal
......@@ -294,7 +294,7 @@
21.1d0))
(concatenate-grids
(make-grid-sequential-elements
:offset 0.5 :destination-specification '((array 3 4) double-float))
:offset 0.5d0 :destination-specification '((array 3 4) double-float))
(make-grid-sequential-elements
:offset 0.1 :destination-specification '((array 3 2) double-float))
:offset 0.1d0 :destination-specification '((array 3 2) double-float))
:axis 1 :gtype-OBSOLETE '(list list double-float))))
;; Floating point numbers.
;; Liam Healy Wed May 8 2002 - 10:47
;; Time-stamp: <2013-05-26 18:41:07EDT float.lisp>
;; Time-stamp: <2015-04-25 12:11:26EDT float.lisp>
;; Copyright 2011, 2012 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -200,14 +200,17 @@
(if significant-figures
(format-float-switch float significant-figures print-sign)
(format-float-fixed
float intpart-digits fracpart-digits
(if (typep float 'rational)
(cl:coerce float *read-default-float-format*)
float)
intpart-digits fracpart-digits
intpart-fill
print-sign)
;; Used to be:
;; significant-figures=nil and fracpart-digits=nil means print
;; CL's default (full precision) format
;; (princ-to-string float)
))
print-sign)))
;; Used to be:
;; significant-figures=nil and fracpart-digits=nil means print
;; CL's default (full precision) format
;; (princ-to-string float)
;;;;****************************************************************************
;;;; nf
......
;; Arithmetic with physical dimension quantities.
;; Liam Healy Fri Apr 22 2005 - 09:58
;; Time-stamp: <2013-03-21 22:26:26EDT arithmetic.lisp>
;; Time-stamp: <2015-09-07 09:39:33EDT arithmetic.lisp>
;; Copyright 2011 Liam M. Healy
;; Copyright 2011, 2013, 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
......@@ -216,15 +216,15 @@
(scalar-dimension x)))
(defmethod zerop ((x physical-quantity))
(antik:zerop (pqval x)))
(zerop (pq-magnitude x)))
(defmethod minusp ((x physical-quantity))
(undimensioned-should-not-be-here)
(antik:minusp (pqval x)))
(minusp (pq-magnitude x)))
(defmethod plusp ((x physical-quantity))
(undimensioned-should-not-be-here)
(antik:plusp (pqval x)))
(plusp (pq-magnitude x)))
(defmethod floor ((x physical-quantity) &optional (y 1))
(undimensioned-should-not-be-here)
......
;; Physical dimension quantity with a magnitude that is a scalar
;; Liam Healy 2011-01-01 12:05:37EST grid.lisp
;; Time-stamp: <2013-03-23 18:55:13EDT scalar.lisp>
;; Time-stamp: <2015-04-25 10:18:08EDT scalar.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -70,7 +70,8 @@
t))) ; only check vectors for non-scalar units
(dimel)
"~a is not a dimel" dimel)
(if (equal dimel (dimension 'dimensionless))
(if (or (and *zero-is-dimensionless* (zerop mag) (not (grid:gridp mag)))
(equal dimel (dimension 'dimensionless)))
mag
(make-instance
'physical-quantity
......
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