annotate fft/fftw/fftw-3.3.4/genfft/littlesimp.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 (*
Chris@19 23 * The LittleSimplifier module implements a subset of the simplifications
Chris@19 24 * of the AlgSimp module. These simplifications can be executed
Chris@19 25 * quickly here, while they would take a long time using the heavy
Chris@19 26 * machinery of AlgSimp.
Chris@19 27 *
Chris@19 28 * For example, 0 * x is simplified to 0 tout court by the LittleSimplifier.
Chris@19 29 * On the other hand, AlgSimp would first simplify x, generating lots
Chris@19 30 * of common subexpressions, storing them in a table etc, just to
Chris@19 31 * discard all the work later. Similarly, the LittleSimplifier
Chris@19 32 * reduces the constant FFT in Rader's algorithm to a constant sequence.
Chris@19 33 *)
Chris@19 34
Chris@19 35 open Expr
Chris@19 36
Chris@19 37 let rec makeNum = function
Chris@19 38 | n -> Num n
Chris@19 39
Chris@19 40 and makeUminus = function
Chris@19 41 | Uminus a -> a
Chris@19 42 | Num a -> makeNum (Number.negate a)
Chris@19 43 | a -> Uminus a
Chris@19 44
Chris@19 45 and makeTimes = function
Chris@19 46 | (Num a, Num b) -> makeNum (Number.mul a b)
Chris@19 47 | (Num a, Times (Num b, c)) -> makeTimes (makeNum (Number.mul a b), c)
Chris@19 48 | (Num a, b) when Number.is_zero a -> makeNum (Number.zero)
Chris@19 49 | (Num a, b) when Number.is_one a -> b
Chris@19 50 | (Num a, b) when Number.is_mone a -> makeUminus b
Chris@19 51 | (Num a, Uminus b) -> Times (makeUminus (Num a), b)
Chris@19 52 | (a, (Num b as b')) -> makeTimes (b', a)
Chris@19 53 | (a, b) -> Times (a, b)
Chris@19 54
Chris@19 55 and makePlus l =
Chris@19 56 let rec reduceSum x = match x with
Chris@19 57 [] -> []
Chris@19 58 | [Num a] -> if Number.is_zero a then [] else x
Chris@19 59 | (Num a) :: (Num b) :: c ->
Chris@19 60 reduceSum ((makeNum (Number.add a b)) :: c)
Chris@19 61 | ((Num _) as a') :: b :: c -> b :: reduceSum (a' :: c)
Chris@19 62 | a :: s -> a :: reduceSum s
Chris@19 63
Chris@19 64 in match reduceSum l with
Chris@19 65 [] -> makeNum (Number.zero)
Chris@19 66 | [a] -> a
Chris@19 67 | [a; b] when a == b -> makeTimes (Num Number.two, a)
Chris@19 68 | [Times (Num a, b); Times (Num c, d)] when b == d ->
Chris@19 69 makeTimes (makePlus [Num a; Num c], b)
Chris@19 70 | a -> Plus a
Chris@19 71