annotate fft/fftw/fftw-3.3.4/genfft/util.ml @ 40:223f770b5341 kissfft-double tip

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