Commit afc6fb36 authored by Liam Healy's avatar Liam Healy

Read seconds as a double-float

Antik no longer rebinds *read-default-float-format*. If it is 'single-float, there could be some unexpected precision loss when parsing time intervals, so it is rebound to 'double-float for reading times. The seconds part of timeparse can now be a rational. If it's an integer, the time interval will be formatted as an integer for output. If it's a rational, the time interval will be coerced to a double float.
parent 14dc16d8
;; 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
;;;;****************************************************************************
......
;; 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
......
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