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