Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Sébastien Villemot
antik
Commits
e31d94c7
Commit
e31d94c7
authored
Nov 15, 2015
by
Liam M. Healy
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'multiple-systems' into documentation
parents
9f6f3dc2
29ba9721
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
99 additions
and
65 deletions
+99
-65
date-time/formats.lisp
date-time/formats.lisp
+13
-10
date-time/iso8601.lisp
date-time/iso8601.lisp
+17
-14
date-time/time-interval.lisp
date-time/time-interval.lisp
+20
-9
grid/format-output.lisp
grid/format-output.lisp
+24
-11
grid/tests/compose.lisp
grid/tests/compose.lisp
+6
-6
input-output/float.lisp
input-output/float.lisp
+11
-8
physical-quantities/arithmetic.lisp
physical-quantities/arithmetic.lisp
+5
-5
physical-quantities/scalar.lisp
physical-quantities/scalar.lisp
+3
-2
No files found.
date-time/formats.lisp
View file @
e31d94c7
;; Datime formats, compatibility with non-iso8601.
;; Liam Healy Fri Oct 12 2001 - 16:27
;; Time-stamp: <201
4
-0
1-13 21:55:47ES
T formats.lisp>
;; Time-stamp: <201
5
-0
9-07 10:02:16ED
T 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 J
D 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 J
2000 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}"
)))
date-time/iso8601.lisp
View file @
e31d94c7
;; ISO 8601:2000(E) time and date representation
;; Liam Healy Sat Aug 7 1999 - 18:07
;; Time-stamp: <201
4
-0
1-13 22:03:16ES
T iso8601.lisp>
;; Time-stamp: <201
5
-0
4-25 12:32:19ED
T 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?
date-time/time-interval.lisp
View file @
e31d94c7
;; Time interval parsing and generating.
;; Liam Healy Thu May 2 2002 - 16:34
;; Time-stamp: <201
4-10-06 22:37:13
EDT time-interval.lisp>
;; Time-stamp: <201
5-04-25 13:07:07
EDT 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
;;;;****************************************************************************
...
...
grid/format-output.lisp
View file @
e31d94c7
;; Format numerical output for grids and sequences
;; Liam Healy Wed Dec 11 2002 - 16:37
;; Time-stamp: <201
4
-0
1-14 22:27:3
6E
S
T format-output.lisp>
;; Time-stamp: <201
5
-0
4-26 22:45:4
6E
D
T 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
...
...
grid/tests/compose.lisp
View file @
e31d94c7
;; Tests of grid composition functions
;; Liam Healy 2009-11-28 17:12:53EST compose.lisp
;; Time-stamp: <201
3-12
-2
8
1
0:2
2:
4
6E
S
T compose.lisp>
;; Time-stamp: <201
5-04
-2
5
1
4:5
2:
2
6E
D
T 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.5
d0
: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.5
d0
:destination-specification
'
((
array
3
4
)
double-float
))
(
make-grid-sequential-elements
:offset
0.1
:destination-specification
'
((
array
3
2
)
double-float
))
:offset
0.1
d0
: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.5
d0
:destination-specification
'
((
array
3
4
)
double-float
))
(
make-grid-sequential-elements
:offset
0.1
:destination-specification
'
((
array
3
2
)
double-float
))
:offset
0.1
d0
:destination-specification
'
((
array
3
2
)
double-float
))
:axis
1
:gtype-OBSOLETE
'
(
list
list
double-float
))))
input-output/float.lisp
View file @
e31d94c7
;; Floating point numbers.
;; Liam Healy Wed May 8 2002 - 10:47
;; Time-stamp: <201
3
-0
5
-2
6
1
8:41:07
EDT float.lisp>
;; Time-stamp: <201
5
-0
4
-2
5
1
2:11:26
EDT 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) forma
t
;; (princ-to-string flo
at
)
)
)
print-sign
)
))
;; Used to be:
;; significant-figures=nil and fracpart-digits=nil means prin
t
;; CL's default (full precision) form
at
;; (princ-to-string float
)
;;;;****************************************************************************
;;;; nf
...
...
physical-quantities/arithmetic.lisp
View file @
e31d94c7
;; Arithmetic with physical dimension quantities.
;; Liam Healy Fri Apr 22 2005 - 09:58
;; Time-stamp: <201
3
-0
3-21 22:26:26
EDT arithmetic.lisp>
;; Time-stamp: <201
5
-0
9-07 09:39:33
EDT 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
(
pq
val
x
)))
(
zerop
(
pq
-magnitude
x
)))
(
defmethod
minusp
((
x
physical-quantity
))
(
undimensioned-should-not-be-here
)
(
antik:
minusp
(
pq
val
x
)))
(
minusp
(
pq
-magnitude
x
)))
(
defmethod
plusp
((
x
physical-quantity
))
(
undimensioned-should-not-be-here
)
(
antik:
plusp
(
pq
val
x
)))
(
plusp
(
pq
-magnitude
x
)))
(
defmethod
floor
((
x
physical-quantity
)
&optional
(
y
1
))
(
undimensioned-should-not-be-here
)
...
...
physical-quantities/scalar.lisp
View file @
e31d94c7
;; Physical dimension quantity with a magnitude that is a scalar
;; Liam Healy 2011-01-01 12:05:37EST grid.lisp
;; Time-stamp: <201
3
-0
3
-2
3
1
8:55:13
EDT scalar.lisp>
;; Time-stamp: <201
5
-0
4
-2
5
1
0:18:08
EDT 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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment