diff options
Diffstat (limited to 'tools.ml')
| -rwxr-xr-x | tools.ml | 126 |
1 files changed, 26 insertions, 100 deletions
@@ -177,6 +177,21 @@ module List = struct in Array.init (List.length l) build end + let linearize elems = begin + let rec _linearize acc (elems:'a list list) : 'a list = begin + let split (hds, tls) = function + | hd::tl -> hd::hds, tl::tls + | [] -> hds, tls + in + match elems with + | [] -> acc + | elems -> + let acc, tls = List.fold_left split (acc, []) elems in + _linearize acc tls + end in + List.rev @@ _linearize [] elems + end + end module Tuple2 = struct @@ -268,106 +283,7 @@ end module Date = struct - 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 - + include Date end @@ -435,6 +351,8 @@ module Map(Ord: COMPARABLE_TYPE) = struct type 'a key = 'a Ord.t + type wrapper = Ex: 'a key * 'a -> wrapper + type t = | Empty : t | Node : t * 'a key * 'a * t * int -> t @@ -513,4 +431,12 @@ module Map(Ord: COMPARABLE_TYPE) = struct | Gt -> mem x r end + let rec fold: ('a -> wrapper -> 'a) -> 'a -> t -> 'a = + begin fun f init t -> match t with + | Empty -> init + | Node(l, k, v, r, _) -> + let res_left = fold f init l in + let result = f res_left @@ Ex (k, v) in + fold f result r + end end |