Chris@19: (* Chris@19: * Copyright (c) 1997-1999 Massachusetts Institute of Technology Chris@19: * Copyright (c) 2003, 2007-14 Matteo Frigo Chris@19: * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology Chris@19: * Chris@19: * This program is free software; you can redistribute it and/or modify Chris@19: * it under the terms of the GNU General Public License as published by Chris@19: * the Free Software Foundation; either version 2 of the License, or Chris@19: * (at your option) any later version. Chris@19: * Chris@19: * This program is distributed in the hope that it will be useful, Chris@19: * but WITHOUT ANY WARRANTY; without even the implied warranty of Chris@19: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Chris@19: * GNU General Public License for more details. Chris@19: * Chris@19: * You should have received a copy of the GNU General Public License Chris@19: * along with this program; if not, write to the Free Software Chris@19: * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Chris@19: * Chris@19: *) Chris@19: Chris@19: (* various utility functions *) Chris@19: open List Chris@19: open Unix Chris@19: Chris@19: (***************************************** Chris@19: * Integer operations Chris@19: *****************************************) Chris@19: (* fint the inverse of n modulo m *) Chris@19: let invmod n m = Chris@19: let rec loop i = Chris@19: if ((i * n) mod m == 1) then i Chris@19: else loop (i + 1) Chris@19: in Chris@19: loop 1 Chris@19: Chris@19: (* Yooklid's algorithm *) Chris@19: let rec gcd n m = Chris@19: if (n > m) Chris@19: then gcd m n Chris@19: else Chris@19: let r = m mod n Chris@19: in Chris@19: if (r == 0) then n Chris@19: else gcd r n Chris@19: Chris@19: (* reduce the fraction m/n to lowest terms, modulo factors of n/n *) Chris@19: let lowest_terms n m = Chris@19: if (m mod n == 0) then Chris@19: (1,0) Chris@19: else Chris@19: let nn = (abs n) in let mm = m * (n / nn) Chris@19: in let mpos = Chris@19: if (mm > 0) then (mm mod nn) Chris@19: else (mm + (1 + (abs mm) / nn) * nn) mod nn Chris@19: and d = gcd nn (abs mm) Chris@19: in (nn / d, mpos / d) Chris@19: Chris@19: (* find a generator for the multiplicative group mod p Chris@19: (where p must be prime for a generator to exist!!) *) Chris@19: Chris@19: exception No_Generator Chris@19: Chris@19: let find_generator p = Chris@19: let rec period x prod = Chris@19: if (prod == 1) then 1 Chris@19: else 1 + (period x (prod * x mod p)) Chris@19: in let rec findgen x = Chris@19: if (x == 0) then raise No_Generator Chris@19: else if ((period x x) == (p - 1)) then x Chris@19: else findgen ((x + 1) mod p) Chris@19: in findgen 1 Chris@19: Chris@19: (* raise x to a power n modulo p (requires n > 0) (in principle, Chris@19: negative powers would be fine, provided that x and p are relatively Chris@19: prime...we don't need this functionality, though) *) Chris@19: Chris@19: exception Negative_Power Chris@19: Chris@19: let rec pow_mod x n p = Chris@19: if (n == 0) then 1 Chris@19: else if (n < 0) then raise Negative_Power Chris@19: else if (n mod 2 == 0) then pow_mod (x * x mod p) (n / 2) p Chris@19: else x * (pow_mod x (n - 1) p) mod p Chris@19: Chris@19: (****************************************** Chris@19: * auxiliary functions Chris@19: ******************************************) Chris@19: let rec forall id combiner a b f = Chris@19: if (a >= b) then id Chris@19: else combiner (f a) (forall id combiner (a + 1) b f) Chris@19: Chris@19: let sum_list l = fold_right (+) l 0 Chris@19: let max_list l = fold_right (max) l (-999999) Chris@19: let min_list l = fold_right (min) l 999999 Chris@19: let count pred = fold_left Chris@19: (fun a elem -> if (pred elem) then 1 + a else a) 0 Chris@19: let remove elem = List.filter (fun e -> (e != elem)) Chris@19: let cons a b = a :: b Chris@19: let null = function Chris@19: [] -> true Chris@19: | _ -> false Chris@19: let for_list l f = List.iter f l Chris@19: let rmap l f = List.map f l Chris@19: Chris@19: (* functional composition *) Chris@19: let (@@) f g x = f (g x) Chris@19: Chris@19: let forall_flat a b = forall [] (@) a b Chris@19: Chris@19: let identity x = x Chris@19: Chris@19: let rec minimize f = function Chris@19: [] -> None Chris@19: | elem :: rest -> Chris@19: match minimize f rest with Chris@19: None -> Some elem Chris@19: | Some x -> if (f x) >= (f elem) then Some elem else Some x Chris@19: Chris@19: Chris@19: let rec find_elem condition = function Chris@19: [] -> None Chris@19: | elem :: rest -> Chris@19: if condition elem then Chris@19: Some elem Chris@19: else Chris@19: find_elem condition rest Chris@19: Chris@19: Chris@19: (* find x, x >= a, such that (p x) is true *) Chris@19: let rec suchthat a pred = Chris@19: if (pred a) then a else suchthat (a + 1) pred Chris@19: Chris@19: (* print an information message *) Chris@19: let info string = Chris@19: if !Magic.verbose then begin Chris@19: let now = Unix.times () Chris@19: and pid = Unix.getpid () in Chris@19: prerr_string ((string_of_int pid) ^ ": " ^ Chris@19: "at t = " ^ (string_of_float now.tms_utime) ^ " : "); Chris@19: prerr_string (string ^ "\n"); Chris@19: flush Pervasives.stderr; Chris@19: end Chris@19: Chris@19: (* iota n produces the list [0; 1; ...; n - 1] *) Chris@19: let iota n = forall [] cons 0 n identity Chris@19: Chris@19: (* interval a b produces the list [a; 1; ...; b - 1] *) Chris@19: let interval a b = List.map ((+) a) (iota (b - a)) Chris@19: Chris@19: (* Chris@19: * freeze a function, i.e., compute it only once on demand, and Chris@19: * cache it into an array. Chris@19: *) Chris@19: let array n f = Chris@19: let a = Array.init n (fun i -> lazy (f i)) Chris@19: in fun i -> Lazy.force a.(i) Chris@19: Chris@19: Chris@19: let rec take n l = Chris@19: match (n, l) with Chris@19: (0, _) -> [] Chris@19: | (n, (a :: b)) -> a :: (take (n - 1) b) Chris@19: | _ -> failwith "take" Chris@19: Chris@19: let rec drop n l = Chris@19: match (n, l) with Chris@19: (0, _) -> l Chris@19: | (n, (_ :: b)) -> drop (n - 1) b Chris@19: | _ -> failwith "drop" Chris@19: Chris@19: Chris@19: let either a b = Chris@19: match a with Chris@19: Some x -> x Chris@19: | _ -> b