1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
|
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module : Graphics.Rendering.Chart.Axis.Time
-- Copyright : (c) Tim Docker 2010, 2014
-- License : BSD-style (see chart/COPYRIGHT)
--
-- Calculate and render time axes
module Graphics.Rendering.Chart.Axis.Time(
TimeSeq,
TimeLabelFn,
TimeLabelAlignment(..),
TimeValue (..),
timeValueAxis,
autoTimeValueAxis,
days, months, years,
) where
import Data.Default.Class
#if MIN_VERSION_time(1,5,0)
import Data.Time hiding (months)
#else
import Data.Time
import System.Locale (defaultTimeLocale)
#endif
import Data.Fixed
import Control.Lens
import Graphics.Rendering.Chart.Axis.Types
import Graphics.Rendering.Chart.Geometry (Range)
-- | A typeclass abstracting the functions we need
-- to be able to plot against an axis of time type @d@.
class TimeValue t where
utctimeFromTV :: t -> UTCTime
tvFromUTCTime :: UTCTime -> t
{-# MINIMAL utctimeFromTV, tvFromUTCTime #-}
doubleFromTimeValue :: t -> Double
doubleFromTimeValue = doubleFromTimeValue . utctimeFromTV
timeValueFromDouble :: Double -> t
timeValueFromDouble = tvFromUTCTime . timeValueFromDouble
instance TimeValue UTCTime where
utctimeFromTV = id
tvFromUTCTime = id
doubleFromTimeValue = doubleFromUTCTime
timeValueFromDouble = utcTimeFromDouble
instance TimeValue Day where
utctimeFromTV d = UTCTime d 0
tvFromUTCTime = utctDay
doubleFromTimeValue = doubleFromDay
timeValueFromDouble = dayFromDouble
instance TimeValue LocalTime where
utctimeFromTV (LocalTime d tod) = UTCTime d (timeOfDayToTime tod)
tvFromUTCTime (UTCTime d dt) = LocalTime d (timeToTimeOfDay dt)
----------------------------------------------------------------------
instance PlotValue LocalTime where
toValue = doubleFromTimeValue
fromValue = timeValueFromDouble
autoAxis = autoTimeValueAxis
instance PlotValue UTCTime where
toValue = doubleFromTimeValue
fromValue = timeValueFromDouble
autoAxis = autoTimeValueAxis
instance PlotValue Day where
toValue = doubleFromTimeValue
fromValue = timeValueFromDouble
autoAxis = autoTimeValueAxis
----------------------------------------------------------------------
-- | Map a UTCTime value to a plot coordinate.
doubleFromUTCTime :: UTCTime -> Double
doubleFromUTCTime ut = fromIntegral (toModifiedJulianDay (utctDay ut))
+ fromRational (timeOfDayToDayFraction (timeToTimeOfDay (utctDayTime ut)))
-- | Map a plot coordinate to a UTCTime.
utcTimeFromDouble :: Double -> UTCTime
utcTimeFromDouble v =
UTCTime (ModifiedJulianDay i) (timeOfDayToTime (dayFractionToTimeOfDay (toRational d)))
where
(i,d) = properFraction v
-- | Map a Day value to a plot coordinate.
doubleFromDay :: Day -> Double
doubleFromDay d = fromIntegral (toModifiedJulianDay d)
-- | Map a plot coordinate to a Day.
dayFromDouble :: Double -> Day
dayFromDouble v = ModifiedJulianDay (truncate v)
----------------------------------------------------------------------
-- | TimeSeq is a (potentially infinite) set of times. When passed
-- a reference time, the function returns a a pair of lists. The first
-- contains all times in the set less than the reference time in
-- decreasing order. The second contains all times in the set greater
-- than or equal to the reference time, in increasing order.
type TimeSeq = UTCTime -> ([UTCTime],[UTCTime])
coverTS :: TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
coverTS tseq minT maxT = min' ++ enumerateTS tseq minT maxT ++ max'
where
min' = if elemTS minT tseq then [] else take 1 (fst (tseq minT))
max' = if elemTS maxT tseq then [] else take 1 (snd (tseq maxT))
enumerateTS :: TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
enumerateTS tseq minT maxT =
reverse (takeWhile (>=minT) ts1) ++ takeWhile (<=maxT) ts2
where
(ts1,ts2) = tseq minT
elemTS :: UTCTime -> TimeSeq -> Bool
elemTS t tseq = case tseq t of
(_,t0:_) | t == t0 -> True
_ -> False
-- | How to display a time
type TimeLabelFn = UTCTime -> String
data TimeLabelAlignment = UnderTicks
| BetweenTicks
deriving (Show)
-- | Create an 'AxisFn' to for a time axis.
--
-- The values to be plotted against this axis can be created with
-- 'doubleFromLocalTime'.
--
-- Implementation detail: 'PlotValue' constraint is needed to use `vmap`.
timeValueAxis ::
TimeValue t
=> TimeSeq
-- ^ Set the minor ticks, and the final range will be aligned to its
-- elements.
-> TimeSeq
-- ^ Set the labels and grid.
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-- ^ Set the second line of labels.
-> TimeLabelFn
-- ^ Format @t@ for labels.
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis tseq lseq labelf lal cseq contextf clal pts = AxisData {
_axis_visibility = def,
_axis_viewport = vmap' (tvFromUTCTime min', tvFromUTCTime max'),
_axis_tropweiv = invmap' (tvFromUTCTime min', tvFromUTCTime max'),
_axis_ticks = [ (tvFromUTCTime t,2) | t <- times] ++ [ (tvFromUTCTime t,5) | t <- ltimes, visible t],
_axis_labels = [ [ (tvFromUTCTime t,l) | (t,l) <- labels labelf ltimes lal, visible t]
, [ (tvFromUTCTime t,l) | (t,l) <- labels contextf ctimes clal, visible t]
],
_axis_grid = [ tvFromUTCTime t | t <- ltimes, visible t]
}
where
(minT,maxT) = case pts of
[] -> (refTimeValue,refTimeValue)
ps -> (minimum (map utctimeFromTV ps), maximum (map utctimeFromTV ps))
refTimeValue = timeValueFromDouble 0
times, ltimes, ctimes :: [UTCTime]
times = coverTS tseq minT maxT
ltimes = coverTS lseq minT maxT
ctimes = coverTS cseq minT maxT
min' = minimum times
max' = maximum times
visible t = min' <= t && t <= max'
labels f ts lal' =
[ (align lal' m1' m2', f m1)
| (m1,m2) <- zip ts (tail ts)
, let m1' = if m1<min' then min' else m1
, let m2' = if m2>max' then max' else m2 ]
align BetweenTicks m1 m2 = avg m1 m2
align UnderTicks m1 _ = m1
avg m1 m2 = timeValueFromDouble $ m1' + (m2' - m1')/2
where
m1' = doubleFromTimeValue m1
m2' = doubleFromTimeValue m2
vmap' :: TimeValue x => (x,x) -> Range -> x -> Double
vmap' (v1,v2) (v3,v4) v = v3 + (doubleFromTimeValue v - doubleFromTimeValue v1) * (v4-v3)
/ (doubleFromTimeValue v2 - doubleFromTimeValue v1)
invmap' :: TimeValue x => (x,x) -> Range -> Double -> x
invmap' (v3,v4) (d1,d2) d = timeValueFromDouble (doubleFromTimeValue v3 + ( (d-d1) * doubleRange
/ (d2-d1) ))
where doubleRange = doubleFromTimeValue v4 - doubleFromTimeValue v3
truncateTo :: Real a => a -> a -> a
truncateTo t step = t - t `mod'` step
secondSeq :: NominalDiffTime -> TimeSeq
secondSeq step t@(UTCTime day dt) = (iterate rev t1, tail (iterate fwd t1))
where t0 = UTCTime day (truncateTo dt step')
t1 = if t0 < t then t0 else rev t0
rev = addUTCTime (negate step)
fwd = addUTCTime step
step' = realToFrac step
millis1, millis10, millis100, seconds, fiveSeconds :: TimeSeq
millis1 = secondSeq (1 / 1000)
millis10 = secondSeq (1 / 100)
millis100 = secondSeq (1 / 10)
seconds = secondSeq 1
fiveSeconds = secondSeq 5
minutes, fiveMinutes :: TimeSeq
minutes = secondSeq 60
fiveMinutes = secondSeq (5 * 60)
-- | A 'TimeSeq' for hours.
hours :: TimeSeq
hours = secondSeq (60 * 60)
-- | A 'TimeSeq' for calendar days.
days :: TimeSeq
days t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))
where t0 = utctDay t
t1 = if toTime t0 < t then t0 else rev t0
rev = pred
fwd = succ
toTime d = UTCTime d 0
-- | A 'TimeSeq' for calendar months.
months :: TimeSeq
months t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))
where t0 = let (y,m,_) = toGregorian $ utctDay t in fromGregorian y m 1
t1 = if toTime t0 < t then t0 else rev t0
rev = addGregorianMonthsClip (-1)
fwd = addGregorianMonthsClip 1
toTime d = UTCTime d 0
-- | A 'TimeSeq' for calendar years.
years :: TimeSeq
years t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))
where t0 = toGregorian (utctDay t) ^. _1
t1 = if toTime t0 < t then t0 else rev t0
rev = pred
fwd = succ
toTime y = UTCTime (fromGregorian y 1 1) 0
-- | A 'TimeSeq' for no sequence at all.
noTime :: TimeSeq
noTime _ = ([],[])
-- | Automatically choose a suitable time axis, based upon the time range
-- of data. The values to be plotted against this axis can be created
-- with 'doubleFromTimeValue'.
autoTimeValueAxis :: TimeValue t => AxisFn t
autoTimeValueAxis pts
| null pts = timeValueAxis days days (ft "%d-%b-%y") UnderTicks
noTime (ft "") UnderTicks []
| 100*dsec<1 = timeValueAxis millis1 millis1 (ft "%S%Q") UnderTicks
noTime (ft "%S%Q") UnderTicks pts
| 10*dsec<1 = timeValueAxis millis10 millis10 (ft "%S%Q") UnderTicks
noTime (ft "%S%Q") UnderTicks pts
| dsec<1 = timeValueAxis millis10 millis100 (ft "%S%Q") UnderTicks
seconds (ft "%M:%S") BetweenTicks pts
| dsec<5 = timeValueAxis millis100 seconds (ft "%M:%S%Q") UnderTicks
seconds (ft "%M:%S") BetweenTicks pts
| dsec<32 = timeValueAxis seconds seconds (ft "%Ss") UnderTicks
minutes (ft "%d-%b-%y %H:%M") BetweenTicks pts
| dsec<120 = timeValueAxis seconds fiveSeconds (ft "%Ss") UnderTicks
minutes (ft "%d-%b-%y %H:%M") BetweenTicks pts
| dsec<7*60 = timeValueAxis fiveSeconds minutes (ft "%Mm") UnderTicks
hours (ft "%d-%b-%y %H:00") BetweenTicks pts
| dsec<32*60 = timeValueAxis minutes minutes (ft "%Mm") UnderTicks
hours (ft "%d-%b-%y %H:00") BetweenTicks pts
| dsec<90*60 = timeValueAxis minutes fiveMinutes (ft "%Mm") UnderTicks
hours (ft "%d-%b-%y %H:00") BetweenTicks pts
| dsec<4*3600 = timeValueAxis fiveMinutes hours (ft "%H:%M") UnderTicks
days (ft "%d-%b-%y") BetweenTicks pts
| dsec<32*3600 = timeValueAxis hours hours (ft "%H:%M") UnderTicks
days (ft "%d-%b-%y") BetweenTicks pts
| dday<4 = timeValueAxis hours days (ft "%d-%b-%y") BetweenTicks
noTime (ft "") BetweenTicks pts
| dday<12 = timeValueAxis days days (ft "%d-%b") BetweenTicks
years (ft "%Y") BetweenTicks pts
| dday<45 = timeValueAxis days days (ft "%d") BetweenTicks
months (ft "%b-%y") BetweenTicks pts
| dday<95 = timeValueAxis days months (ft "%b-%y") BetweenTicks
noTime (ft "") BetweenTicks pts
| dday<450 = timeValueAxis months months (ft "%b-%y") BetweenTicks
noTime (ft "") BetweenTicks pts
| dday<735 = timeValueAxis months months (ft "%b") BetweenTicks
years (ft "%Y") BetweenTicks pts
| dday<1800 = timeValueAxis months years (ft "%Y") BetweenTicks
noTime (ft "") BetweenTicks pts
| otherwise = timeValueAxis years years (ft "%Y") BetweenTicks
noTime (ft "") BetweenTicks pts
where
upts = map utctimeFromTV pts
dsec = diffUTCTime t1 t0 -- seconds
dday = dsec / 86400 -- days
t1 = maximum upts
t0 = minimum upts
ft = formatTime defaultTimeLocale
|
