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
|
-----------------------------------------------------------------------------
-- |
-- Module : Graphics.Rendering.Chart.Axis.LocalTime
-- Copyright : (c) Tim Docker 2010, 2014
-- License : BSD-style (see chart/COPYRIGHT)
--
-- Calculate and render time axes
module Graphics.Rendering.Chart.Axis.LocalTime(
TimeSeq,
TimeLabelFn,
TimeLabelAlignment(..),
timeAxis,
autoTimeAxis,
days, months, years,
-- * Utilities
doubleFromLocalTime
) where
import Data.Default.Class
import Data.Time
import Data.Fixed
import System.Locale (defaultTimeLocale)
import Control.Lens
import Graphics.Rendering.Chart.Axis.Types
instance PlotValue LocalTime where
toValue = doubleFromLocalTime
fromValue = localTimeFromDouble
autoAxis = autoTimeAxis
----------------------------------------------------------------------
-- | Map a LocalTime value to a plot coordinate.
doubleFromLocalTime :: LocalTime -> Double
doubleFromLocalTime lt = fromIntegral (toModifiedJulianDay (localDay lt))
+ fromRational (timeOfDayToDayFraction (localTimeOfDay lt))
-- | Map a plot coordinate to a LocalTime.
localTimeFromDouble :: Double -> LocalTime
localTimeFromDouble v =
LocalTime (ModifiedJulianDay i) (dayFractionToTimeOfDay (toRational d))
where
(i,d) = properFraction 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 = LocalTime-> ([LocalTime],[LocalTime])
coverTS :: TimeSeq -> LocalTime -> LocalTime -> [LocalTime]
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 -> LocalTime -> LocalTime -> [LocalTime]
enumerateTS tseq minT maxT =
reverse (takeWhile (>=minT) ts1) ++ takeWhile (<=maxT) ts2
where
(ts1,ts2) = tseq minT
elemTS :: LocalTime -> TimeSeq -> Bool
elemTS t tseq = case tseq t of
(_,t0:_) | t == t0 -> True
_ -> False
-- | How to display a time
type TimeLabelFn = LocalTime -> 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'.
timeAxis ::
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 `LocalTime` for labels.
-> TimeLabelAlignment
-> AxisFn LocalTime
timeAxis tseq lseq labelf lal cseq contextf clal pts = AxisData {
_axis_visibility = def,
_axis_viewport = vmap(min', max'),
_axis_tropweiv = invmap(min', max'),
_axis_ticks = [ (t,2) | t <- times] ++ [ (t,5) | t <- ltimes, visible t],
_axis_labels = [ [ (t,l) | (t,l) <- labels labelf ltimes lal, visible t]
, [ (t,l) | (t,l) <- labels contextf ctimes clal, visible t]
],
_axis_grid = [ t | t <- ltimes, visible t]
}
where
(minT,maxT) = case pts of
[] -> (refLocalTime,refLocalTime)
ps -> (minimum ps, maximum ps)
refLocalTime = LocalTime (ModifiedJulianDay 0) midnight
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 = localTimeFromDouble $ m1' + (m2' - m1')/2
where
m1' = doubleFromLocalTime m1
m2' = doubleFromLocalTime m2
normalizeTimeOfDay :: LocalTime -> LocalTime
normalizeTimeOfDay t@(LocalTime day (TimeOfDay h m s))
| s < 0 = normalizeTimeOfDay (LocalTime day (TimeOfDay h (m-1) (s+60)))
| m < 0 = normalizeTimeOfDay (LocalTime day (TimeOfDay (h-1) (m+60) s))
| h < 0 = normalizeTimeOfDay (LocalTime (addDays (-1) day) (TimeOfDay (h+24) m s))
| s >= 60 = normalizeTimeOfDay (LocalTime day (TimeOfDay h (m+s`div'`60)
(s`mod'`60)))
| m >= 60 = normalizeTimeOfDay (LocalTime day (TimeOfDay (h+m`div`60)
(m`mod`60) s))
| h >= 24 = LocalTime (addDays (fromIntegral (h`div`24)) day)
(TimeOfDay (h`mod`24) m s)
| otherwise = t
addTod :: Int -> Int -> Pico -> LocalTime -> LocalTime
addTod dh dm ds (LocalTime day (TimeOfDay h m s)) = normalizeTimeOfDay t'
where t' = LocalTime day (TimeOfDay (h+dh) (m+dm) (s+ds))
truncateTo :: (HasResolution a) => Fixed a -> Fixed a -> Fixed a
truncateTo t step = t - t `mod'` step
secondSeq :: Pico -> TimeSeq
secondSeq step t = (iterate rev t1, tail (iterate fwd t1))
where h0 = todHour (localTimeOfDay t)
m0 = todMin (localTimeOfDay t)
s0 = todSec (localTimeOfDay t) `truncateTo` (1 / 1000)
t0 = LocalTime (localDay t) (TimeOfDay h0 m0 s0)
t1 = if t0 < t then t0 else rev t0
rev = addTod 0 0 (negate step)
fwd = addTod 0 0 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
minuteSeq :: Int -> TimeSeq
minuteSeq step t = (iterate rev t1, tail (iterate fwd t1))
where h0 = todHour (localTimeOfDay t)
m0 = todMin (localTimeOfDay t)
t0 = LocalTime (localDay t) (TimeOfDay h0 m0 0)
t1 = if t0 < t then t0 else rev t0
rev = addTod 0 (negate step) 0
fwd = addTod 0 step 0
minutes, fiveMinutes :: TimeSeq
minutes = minuteSeq 1
fiveMinutes = minuteSeq 5
-- | A 'TimeSeq' for hours.
hours :: TimeSeq
hours t = (iterate rev t1, tail (iterate fwd t1))
where h0 = todHour (localTimeOfDay t)
t0 = LocalTime (localDay t) (TimeOfDay h0 0 0)
t1 = if t0 < t then t0 else rev t0
rev = addTod (-1) 0 0
fwd = addTod 1 0 0
-- | A 'TimeSeq' for calendar days.
days :: TimeSeq
days t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))
where t0 = localDay t
t1 = if toTime t0 < t then t0 else rev t0
rev = pred
fwd = succ
toTime d = LocalTime d midnight
-- | 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 $ localDay t in fromGregorian y m 1
t1 = if toTime t0 < t then t0 else rev t0
rev = addGregorianMonthsClip (-1)
fwd = addGregorianMonthsClip 1
toTime d = LocalTime d midnight
-- | A 'TimeSeq' for calendar years.
years :: TimeSeq
years t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))
where t0 = toGregorian (localDay t) ^. _1
t1 = if toTime t0 < t then t0 else rev t0
rev = pred
fwd = succ
toTime y = LocalTime (fromGregorian y 1 1) midnight
-- | 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 'doubleFromLocalTime'.
autoTimeAxis :: AxisFn LocalTime
autoTimeAxis pts
| null pts = timeAxis days days (ft "%d-%b-%y") UnderTicks
noTime (ft "") UnderTicks []
| tdiff==0 && 100*dsec<1= timeAxis millis1 millis1 (ft "%S%Q") UnderTicks
noTime (ft "%S%Q") UnderTicks pts
| tdiff==0 && 10*dsec<1 = timeAxis millis10 millis10 (ft "%S%Q") UnderTicks
noTime (ft "%S%Q") UnderTicks pts
| tdiff==0 && dsec<1 = timeAxis millis10 millis100 (ft "%S%Q") UnderTicks
seconds (ft "%M:%S") BetweenTicks pts
| tdiff==0 && dsec<5 = timeAxis millis100 seconds (ft "%M:%S%Q") UnderTicks
seconds (ft "%M:%S") BetweenTicks pts
| tdiff==0 && dsec<32 = timeAxis seconds seconds (ft "%Ss") UnderTicks
minutes (ft "%d-%b-%y %H:%M") BetweenTicks pts
| tdiff==0 && dsec<120 = timeAxis seconds fiveSeconds (ft "%Ss") UnderTicks
minutes (ft "%d-%b-%y %H:%M") BetweenTicks pts
| tdiff==0 && dmin<7 = timeAxis fiveSeconds minutes (ft "%Mm") UnderTicks
hours (ft "%d-%b-%y %H:00") BetweenTicks pts
| tdiff==0 && dmin<32 = timeAxis minutes minutes (ft "%Mm") UnderTicks
hours (ft "%d-%b-%y %H:00") BetweenTicks pts
| tdiff==0 && dmin<90 = timeAxis minutes fiveMinutes (ft "%Mm") UnderTicks
hours (ft "%d-%b-%y %H:00") BetweenTicks pts
| tdiff < 2 && dhour<4 = timeAxis fiveMinutes hours (ft "%H:%M") UnderTicks
days (ft "%d-%b-%y") BetweenTicks pts
| tdiff < 2 && dhour<32 = timeAxis hours hours (ft "%H:%M") UnderTicks
days (ft "%d-%b-%y") BetweenTicks pts
| tdiff < 4 = timeAxis hours days (ft "%d-%b-%y") BetweenTicks
noTime (ft "") BetweenTicks pts
| tdiff < 12 = timeAxis days days (ft "%d-%b") BetweenTicks
years (ft "%Y") BetweenTicks pts
| tdiff < 45 = timeAxis days days (ft "%d") BetweenTicks
months (ft "%b-%y") BetweenTicks pts
| tdiff < 95 = timeAxis days months (ft "%b-%y") BetweenTicks
noTime (ft "") BetweenTicks pts
| tdiff < 450 = timeAxis months months (ft "%b-%y") BetweenTicks
noTime (ft "") BetweenTicks pts
| tdiff < 735 = timeAxis months months (ft "%b") BetweenTicks
years (ft "%Y") BetweenTicks pts
| tdiff < 1800 = timeAxis months years (ft "%Y") BetweenTicks
noTime (ft "") BetweenTicks pts
| otherwise = timeAxis years years (ft "%Y") BetweenTicks
noTime (ft "") BetweenTicks pts
where
tdiff = diffDays (localDay t1) (localDay t0)
dhour = if tdiff==0 then h1-h0 else 24*fromIntegral tdiff +h1-h0
dmin = 60*dhour+(m1-m0)
dsec = fromIntegral (60*dmin) + (s1-s0)
(TimeOfDay h0 m0 s0) = localTimeOfDay t0
(TimeOfDay h1 m1 s1) = localTimeOfDay t1
t1 = maximum pts
t0 = minimum pts
ft = formatTime defaultTimeLocale
|
