annotate src/fftw-3.3.5/genfft/util.ml @ 169:223a55898ab9 tip default

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