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