From a6b5a6bdd138a5ccc6827bcc73580df1e9218820 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Fri, 24 Nov 2017 09:22:24 +0100 Subject: Moved all the code to src directory --- date.ml | 120 ---------------------------------------------------------------- 1 file changed, 120 deletions(-) delete mode 100644 date.ml (limited to 'date.ml') diff --git a/date.ml b/date.ml deleted file mode 100644 index 92cb9f6..0000000 --- a/date.ml +++ /dev/null @@ -1,120 +0,0 @@ -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 -- cgit v1.2.3