aboutsummaryrefslogtreecommitdiff
path: root/date.ml
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2017-11-24 09:22:24 +0100
committerSébastien Dailly <sebastien@chimrod.com>2017-11-24 09:23:38 +0100
commita6b5a6bdd138a5ccc6827bcc73580df1e9218820 (patch)
treeff577395c1a5951a61a7234322f927f6ead5ee29 /date.ml
parentecb6fd62c275af03a07d892313ab3914d81cd40e (diff)
Moved all the code to src directory
Diffstat (limited to 'date.ml')
-rw-r--r--date.ml120
1 files changed, 0 insertions, 120 deletions
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