cannam@95: (* cannam@95: * Copyright (c) 1997-1999 Massachusetts Institute of Technology cannam@95: * Copyright (c) 2003, 2007-11 Matteo Frigo cannam@95: * Copyright (c) 2003, 2007-11 Massachusetts Institute of Technology cannam@95: * cannam@95: * This program is free software; you can redistribute it and/or modify cannam@95: * it under the terms of the GNU General Public License as published by cannam@95: * the Free Software Foundation; either version 2 of the License, or cannam@95: * (at your option) any later version. cannam@95: * cannam@95: * This program is distributed in the hope that it will be useful, cannam@95: * but WITHOUT ANY WARRANTY; without even the implied warranty of cannam@95: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the cannam@95: * GNU General Public License for more details. cannam@95: * cannam@95: * You should have received a copy of the GNU General Public License cannam@95: * along with this program; if not, write to the Free Software cannam@95: * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA cannam@95: * cannam@95: *) cannam@95: cannam@95: (* trigonometric transforms *) cannam@95: open Util cannam@95: cannam@95: (* DFT of real input *) cannam@95: let rdft sign n input = cannam@95: Fft.dft sign n (Complex.real @@ input) cannam@95: cannam@95: (* DFT of hermitian input *) cannam@95: let hdft sign n input = cannam@95: Fft.dft sign n (Complex.hermitian n input) cannam@95: cannam@95: (* DFT real transform of vectors of two real numbers, cannam@95: multiplication by (NaN I), and summation *) cannam@95: let dft_via_rdft sign n input = cannam@95: let f = rdft sign n input cannam@95: in fun i -> cannam@95: Complex.plus cannam@95: [Complex.real (f i); cannam@95: Complex.times (Complex.nan Expr.I) (Complex.imag (f i))] cannam@95: cannam@95: (* Discrete Hartley Transform *) cannam@95: let dht sign n input = cannam@95: let f = Fft.dft sign n (Complex.real @@ input) in cannam@95: (fun i -> cannam@95: Complex.plus [Complex.real (f i); Complex.imag (f i)]) cannam@95: cannam@95: let trigI n input = cannam@95: let twon = 2 * n in cannam@95: let input' = Complex.hermitian twon input cannam@95: in cannam@95: Fft.dft 1 twon input' cannam@95: cannam@95: let interleave_zero input = fun i -> cannam@95: if (i mod 2) == 0 cannam@95: then Complex.zero cannam@95: else cannam@95: input ((i - 1) / 2) cannam@95: cannam@95: let trigII n input = cannam@95: let fourn = 4 * n in cannam@95: let input' = Complex.hermitian fourn (interleave_zero input) cannam@95: in cannam@95: Fft.dft 1 fourn input' cannam@95: cannam@95: let trigIII n input = cannam@95: let fourn = 4 * n in cannam@95: let twon = 2 * n in cannam@95: let input' = Complex.hermitian fourn cannam@95: (fun i -> cannam@95: if (i == 0) then cannam@95: Complex.real (input 0) cannam@95: else if (i == twon) then cannam@95: Complex.uminus (Complex.real (input 0)) cannam@95: else cannam@95: Complex.antihermitian twon input i) cannam@95: in cannam@95: let dft = Fft.dft 1 fourn input' cannam@95: in fun k -> dft (2 * k + 1) cannam@95: cannam@95: let zero_extend n input = fun i -> cannam@95: if (i >= 0 && i < n) cannam@95: then input i cannam@95: else Complex.zero cannam@95: cannam@95: let trigIV n input = cannam@95: let fourn = 4 * n cannam@95: and eightn = 8 * n in cannam@95: let input' = Complex.hermitian eightn cannam@95: (zero_extend fourn (Complex.antihermitian fourn cannam@95: (interleave_zero input))) cannam@95: in cannam@95: let dft = Fft.dft 1 eightn input' cannam@95: in fun k -> dft (2 * k + 1) cannam@95: cannam@95: let make_dct scale nshift trig = cannam@95: fun n input -> cannam@95: trig (n - nshift) (Complex.real @@ (Complex.times scale) @@ cannam@95: (zero_extend n input)) cannam@95: (* cannam@95: * DCT-I: y[k] = sum x[j] cos(pi * j * k / n) cannam@95: *) cannam@95: let dctI = make_dct Complex.one 1 trigI cannam@95: cannam@95: (* cannam@95: * DCT-II: y[k] = sum x[j] cos(pi * (j + 1/2) * k / n) cannam@95: *) cannam@95: let dctII = make_dct Complex.one 0 trigII cannam@95: cannam@95: (* cannam@95: * DCT-III: y[k] = sum x[j] cos(pi * j * (k + 1/2) / n) cannam@95: *) cannam@95: let dctIII = make_dct Complex.half 0 trigIII cannam@95: cannam@95: (* cannam@95: * DCT-IV y[k] = sum x[j] cos(pi * (j + 1/2) * (k + 1/2) / n) cannam@95: *) cannam@95: let dctIV = make_dct Complex.half 0 trigIV cannam@95: cannam@95: let shift s input = fun i -> input (i - s) cannam@95: cannam@95: (* DST-x input := TRIG-x (input / i) *) cannam@95: let make_dst scale nshift kshift jshift trig = cannam@95: fun n input -> cannam@95: Complex.real @@ cannam@95: (shift (- jshift) cannam@95: (trig (n + nshift) (Complex.uminus @@ cannam@95: (Complex.times Complex.i) @@ cannam@95: (Complex.times scale) @@ cannam@95: Complex.real @@ cannam@95: (shift kshift (zero_extend n input))))) cannam@95: cannam@95: (* cannam@95: * DST-I: y[k] = sum x[j] sin(pi * j * k / n) cannam@95: *) cannam@95: let dstI = make_dst Complex.one 1 1 1 trigI cannam@95: cannam@95: (* cannam@95: * DST-II: y[k] = sum x[j] sin(pi * (j + 1/2) * k / n) cannam@95: *) cannam@95: let dstII = make_dst Complex.one 0 0 1 trigII cannam@95: cannam@95: (* cannam@95: * DST-III: y[k] = sum x[j] sin(pi * j * (k + 1/2) / n) cannam@95: *) cannam@95: let dstIII = make_dst Complex.half 0 1 0 trigIII cannam@95: cannam@95: (* cannam@95: * DST-IV y[k] = sum x[j] sin(pi * (j + 1/2) * (k + 1/2) / n) cannam@95: *) cannam@95: let dstIV = make_dst Complex.half 0 0 0 trigIV cannam@95: