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
|
module type CALCULABLE = sig
type t
val add: t -> t -> t
val sub: t -> t -> t
val mult: t -> t -> t
val div: t -> t -> t
val floor: t -> t
val of_int: int -> t
val to_int: t -> int
val to_float: t -> float
end
module Make(C : CALCULABLE) = struct
let get_julian_day year month day = begin
let y, m =
if month > 2 then
year, month
else
year - 1, month + 12
in
let b =
if (year > 1582) || (year = 1582 && month > 10) || (year = 1582 && month = 10 && day >= 15) then
let s = y / 100 in
2 - s + (s / 4)
else
0
in
365 * y + y / 4
+ (int_of_float (30.6001 *. (float_of_int (m + 1))))
+ day
+ b
+ 1720995
- 2415019 (* Shift to 30/12/1899 *)
|> C.of_int
end
let date_from_julian_day day = begin
let shift_day = C.add (C.floor day) (C.of_int 2415019) in
let z = C.to_int shift_day in
let f =
if z >= 2299161 then
(* We use the Num module here to prevent overflow *)
let product = C.mult (C.of_int 4) shift_day in
let shifted = C.add product (C.of_int 274277) in
let div = C.div shifted (C.of_int 146097) in
let day' = C.to_int @@ C.floor div in
z + 1401 + ((day' * 3) / 4) - 38
else
z + 1401
in
let e = (4 * f) + 3 in
let h = 5 * ((e mod 1461) / 4) + 2 in (* 1461 is 365.25 * 4 *)
let d = ((h mod 153) / 5) + 1
and m = (((h / 153) + 2) mod 12) + 1 in
let y = (e / 1461) - 4716 + (14 - m) / 12 in (* 4716 is day 2 *)
(y, m, d)
end
let time_from_julian_day j = begin
let day = C.floor j in
let time = C.sub j day in
let h = C.floor @@ C.mult time (C.of_int 24) in
let h_24 = C.div h (C.of_int 24) in
let m = C.floor @@ C.mult (C.of_int 1440) (C.sub time h_24) in
let s = C.mult (C.of_int 86400) (C.sub (C.sub time h_24) (C.div m (C.of_int 1440))) in
(C.to_int h, C.to_int m, s)
end
(** Compute the julian for a given date.
Integer return number of days since November 24, 4714 BC.
Fractionnal part return the time since midnight.
*)
let from_string str = begin
let n = C.of_int in
let date_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+"
and time_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+T[0-9]+:[0-9]+:[0-9]" in
if Str.string_match time_regex str 0 then
Scanf.sscanf str "%d-%d-%dT%d:%d:%d" (fun year month day hour min sec ->
let nhour = C.div (n hour) (n 24)
and nmin = C.div (n min) (n 1440)
and nsec = C.div (n sec) (n 86400) in
C.add (C.add (C.add (get_julian_day year month day) nhour) nmin) nsec
) else if Str.string_match date_regex str 0 then
Scanf.sscanf str "%d-%d-%d" get_julian_day
else (
C.of_int 0
)
end
let to_string date = begin
let y, m, d = date_from_julian_day date
and h, n, s = time_from_julian_day date in
Printf.sprintf "%d-%02d-%02dT%02d:%02d:%02g"
y m d
h n (C.to_float s)
end
end
|
