annotate src/fftw-3.3.5/genfft/util.ml @ 83:ae30d91d2ffe

Replace these with versions built using an older toolset (so as to avoid ABI compatibilities when linking on Ubuntu 14.04 for packaging purposes)
author Chris Cannam
date Fri, 07 Feb 2020 11:51:13 +0000
parents 2cd0e3b3e1fd
children
rev   line source
Chris@42 1 (*
Chris@42 2 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
Chris@42 3 * Copyright (c) 2003, 2007-14 Matteo Frigo
Chris@42 4 * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
Chris@42 5 *
Chris@42 6 * This program is free software; you can redistribute it and/or modify
Chris@42 7 * it under the terms of the GNU General Public License as published by
Chris@42 8 * the Free Software Foundation; either version 2 of the License, or
Chris@42 9 * (at your option) any later version.
Chris@42 10 *
Chris@42 11 * This program is distributed in the hope that it will be useful,
Chris@42 12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
Chris@42 13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
Chris@42 14 * GNU General Public License for more details.
Chris@42 15 *
Chris@42 16 * You should have received a copy of the GNU General Public License
Chris@42 17 * along with this program; if not, write to the Free Software
Chris@42 18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Chris@42 19 *
Chris@42 20 *)
Chris@42 21
Chris@42 22 (* various utility functions *)
Chris@42 23 open List
Chris@42 24 open Unix
Chris@42 25
Chris@42 26 (*****************************************
Chris@42 27 * Integer operations
Chris@42 28 *****************************************)
Chris@42 29 (* fint the inverse of n modulo m *)
Chris@42 30 let invmod n m =
Chris@42 31 let rec loop i =
Chris@42 32 if ((i * n) mod m == 1) then i
Chris@42 33 else loop (i + 1)
Chris@42 34 in
Chris@42 35 loop 1
Chris@42 36
Chris@42 37 (* Yooklid's algorithm *)
Chris@42 38 let rec gcd n m =
Chris@42 39 if (n > m)
Chris@42 40 then gcd m n
Chris@42 41 else
Chris@42 42 let r = m mod n
Chris@42 43 in
Chris@42 44 if (r == 0) then n
Chris@42 45 else gcd r n
Chris@42 46
Chris@42 47 (* reduce the fraction m/n to lowest terms, modulo factors of n/n *)
Chris@42 48 let lowest_terms n m =
Chris@42 49 if (m mod n == 0) then
Chris@42 50 (1,0)
Chris@42 51 else
Chris@42 52 let nn = (abs n) in let mm = m * (n / nn)
Chris@42 53 in let mpos =
Chris@42 54 if (mm > 0) then (mm mod nn)
Chris@42 55 else (mm + (1 + (abs mm) / nn) * nn) mod nn
Chris@42 56 and d = gcd nn (abs mm)
Chris@42 57 in (nn / d, mpos / d)
Chris@42 58
Chris@42 59 (* find a generator for the multiplicative group mod p
Chris@42 60 (where p must be prime for a generator to exist!!) *)
Chris@42 61
Chris@42 62 exception No_Generator
Chris@42 63
Chris@42 64 let find_generator p =
Chris@42 65 let rec period x prod =
Chris@42 66 if (prod == 1) then 1
Chris@42 67 else 1 + (period x (prod * x mod p))
Chris@42 68 in let rec findgen x =
Chris@42 69 if (x == 0) then raise No_Generator
Chris@42 70 else if ((period x x) == (p - 1)) then x
Chris@42 71 else findgen ((x + 1) mod p)
Chris@42 72 in findgen 1
Chris@42 73
Chris@42 74 (* raise x to a power n modulo p (requires n > 0) (in principle,
Chris@42 75 negative powers would be fine, provided that x and p are relatively
Chris@42 76 prime...we don't need this functionality, though) *)
Chris@42 77
Chris@42 78 exception Negative_Power
Chris@42 79
Chris@42 80 let rec pow_mod x n p =
Chris@42 81 if (n == 0) then 1
Chris@42 82 else if (n < 0) then raise Negative_Power
Chris@42 83 else if (n mod 2 == 0) then pow_mod (x * x mod p) (n / 2) p
Chris@42 84 else x * (pow_mod x (n - 1) p) mod p
Chris@42 85
Chris@42 86 (******************************************
Chris@42 87 * auxiliary functions
Chris@42 88 ******************************************)
Chris@42 89 let rec forall id combiner a b f =
Chris@42 90 if (a >= b) then id
Chris@42 91 else combiner (f a) (forall id combiner (a + 1) b f)
Chris@42 92
Chris@42 93 let sum_list l = fold_right (+) l 0
Chris@42 94 let max_list l = fold_right (max) l (-999999)
Chris@42 95 let min_list l = fold_right (min) l 999999
Chris@42 96 let count pred = fold_left
Chris@42 97 (fun a elem -> if (pred elem) then 1 + a else a) 0
Chris@42 98 let remove elem = List.filter (fun e -> (e != elem))
Chris@42 99 let cons a b = a :: b
Chris@42 100 let null = function
Chris@42 101 [] -> true
Chris@42 102 | _ -> false
Chris@42 103 let for_list l f = List.iter f l
Chris@42 104 let rmap l f = List.map f l
Chris@42 105
Chris@42 106 (* functional composition *)
Chris@42 107 let (@@) f g x = f (g x)
Chris@42 108
Chris@42 109 let forall_flat a b = forall [] (@) a b
Chris@42 110
Chris@42 111 let identity x = x
Chris@42 112
Chris@42 113 let rec minimize f = function
Chris@42 114 [] -> None
Chris@42 115 | elem :: rest ->
Chris@42 116 match minimize f rest with
Chris@42 117 None -> Some elem
Chris@42 118 | Some x -> if (f x) >= (f elem) then Some elem else Some x
Chris@42 119
Chris@42 120
Chris@42 121 let rec find_elem condition = function
Chris@42 122 [] -> None
Chris@42 123 | elem :: rest ->
Chris@42 124 if condition elem then
Chris@42 125 Some elem
Chris@42 126 else
Chris@42 127 find_elem condition rest
Chris@42 128
Chris@42 129
Chris@42 130 (* find x, x >= a, such that (p x) is true *)
Chris@42 131 let rec suchthat a pred =
Chris@42 132 if (pred a) then a else suchthat (a + 1) pred
Chris@42 133
Chris@42 134 (* print an information message *)
Chris@42 135 let info string =
Chris@42 136 if !Magic.verbose then begin
Chris@42 137 let now = Unix.times ()
Chris@42 138 and pid = Unix.getpid () in
Chris@42 139 prerr_string ((string_of_int pid) ^ ": " ^
Chris@42 140 "at t = " ^ (string_of_float now.tms_utime) ^ " : ");
Chris@42 141 prerr_string (string ^ "\n");
Chris@42 142 flush Pervasives.stderr;
Chris@42 143 end
Chris@42 144
Chris@42 145 (* iota n produces the list [0; 1; ...; n - 1] *)
Chris@42 146 let iota n = forall [] cons 0 n identity
Chris@42 147
Chris@42 148 (* interval a b produces the list [a; 1; ...; b - 1] *)
Chris@42 149 let interval a b = List.map ((+) a) (iota (b - a))
Chris@42 150
Chris@42 151 (*
Chris@42 152 * freeze a function, i.e., compute it only once on demand, and
Chris@42 153 * cache it into an array.
Chris@42 154 *)
Chris@42 155 let array n f =
Chris@42 156 let a = Array.init n (fun i -> lazy (f i))
Chris@42 157 in fun i -> Lazy.force a.(i)
Chris@42 158
Chris@42 159
Chris@42 160 let rec take n l =
Chris@42 161 match (n, l) with
Chris@42 162 (0, _) -> []
Chris@42 163 | (n, (a :: b)) -> a :: (take (n - 1) b)
Chris@42 164 | _ -> failwith "take"
Chris@42 165
Chris@42 166 let rec drop n l =
Chris@42 167 match (n, l) with
Chris@42 168 (0, _) -> l
Chris@42 169 | (n, (_ :: b)) -> drop (n - 1) b
Chris@42 170 | _ -> failwith "drop"
Chris@42 171
Chris@42 172
Chris@42 173 let either a b =
Chris@42 174 match a with
Chris@42 175 Some x -> x
Chris@42 176 | _ -> b