type t = Num.num 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 *) |> Num.num_of_int end let date_from_julian_day day = begin let shift_day = Num.floor_num day |> Num.add_num (Num.num_of_int 2415019) in let z = Num.int_of_num shift_day in let f = if z >= 2299161 then (* We use the Num module here to prevent overflow *) let day' = Num.(((num_of_int 4) */ shift_day +/ (num_of_int 274277)) // (num_of_int 146097)) |> Num.floor_num |> Num.int_of_num 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 Num.( let day = floor_num j in let time = j -/ day in let h = floor_num @@ time */ (num_of_int 24) in let h_24 = (h // (num_of_int 24)) in let m = floor_num @@ (num_of_int 1440) */ (time -/ h_24 ) in let s = (num_of_int 86400) */ (time -/ h_24 -/ (m // (num_of_int 1440))) in (h, 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 = Num.num_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 -> Num.( let nhour = n hour // (n 24) and nmin = n min // (n 1440) and nsec = n sec // (n 86400) in (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 ( Num.num_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 (Num.int_of_num h) (Num.int_of_num n) (Num.float_of_num s) end