cannam@167
|
1 (*
|
cannam@167
|
2 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
|
cannam@167
|
3 * Copyright (c) 2003, 2007-14 Matteo Frigo
|
cannam@167
|
4 * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
|
cannam@167
|
5 *
|
cannam@167
|
6 * This program is free software; you can redistribute it and/or modify
|
cannam@167
|
7 * it under the terms of the GNU General Public License as published by
|
cannam@167
|
8 * the Free Software Foundation; either version 2 of the License, or
|
cannam@167
|
9 * (at your option) any later version.
|
cannam@167
|
10 *
|
cannam@167
|
11 * This program is distributed in the hope that it will be useful,
|
cannam@167
|
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
|
cannam@167
|
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
cannam@167
|
14 * GNU General Public License for more details.
|
cannam@167
|
15 *
|
cannam@167
|
16 * You should have received a copy of the GNU General Public License
|
cannam@167
|
17 * along with this program; if not, write to the Free Software
|
cannam@167
|
18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
cannam@167
|
19 *
|
cannam@167
|
20 *)
|
cannam@167
|
21
|
cannam@167
|
22 (* trigonometric transforms *)
|
cannam@167
|
23 open Util
|
cannam@167
|
24
|
cannam@167
|
25 (* DFT of real input *)
|
cannam@167
|
26 let rdft sign n input =
|
cannam@167
|
27 Fft.dft sign n (Complex.real @@ input)
|
cannam@167
|
28
|
cannam@167
|
29 (* DFT of hermitian input *)
|
cannam@167
|
30 let hdft sign n input =
|
cannam@167
|
31 Fft.dft sign n (Complex.hermitian n input)
|
cannam@167
|
32
|
cannam@167
|
33 (* DFT real transform of vectors of two real numbers,
|
cannam@167
|
34 multiplication by (NaN I), and summation *)
|
cannam@167
|
35 let dft_via_rdft sign n input =
|
cannam@167
|
36 let f = rdft sign n input
|
cannam@167
|
37 in fun i ->
|
cannam@167
|
38 Complex.plus
|
cannam@167
|
39 [Complex.real (f i);
|
cannam@167
|
40 Complex.times (Complex.nan Expr.I) (Complex.imag (f i))]
|
cannam@167
|
41
|
cannam@167
|
42 (* Discrete Hartley Transform *)
|
cannam@167
|
43 let dht sign n input =
|
cannam@167
|
44 let f = Fft.dft sign n (Complex.real @@ input) in
|
cannam@167
|
45 (fun i ->
|
cannam@167
|
46 Complex.plus [Complex.real (f i); Complex.imag (f i)])
|
cannam@167
|
47
|
cannam@167
|
48 let trigI n input =
|
cannam@167
|
49 let twon = 2 * n in
|
cannam@167
|
50 let input' = Complex.hermitian twon input
|
cannam@167
|
51 in
|
cannam@167
|
52 Fft.dft 1 twon input'
|
cannam@167
|
53
|
cannam@167
|
54 let interleave_zero input = fun i ->
|
cannam@167
|
55 if (i mod 2) == 0
|
cannam@167
|
56 then Complex.zero
|
cannam@167
|
57 else
|
cannam@167
|
58 input ((i - 1) / 2)
|
cannam@167
|
59
|
cannam@167
|
60 let trigII n input =
|
cannam@167
|
61 let fourn = 4 * n in
|
cannam@167
|
62 let input' = Complex.hermitian fourn (interleave_zero input)
|
cannam@167
|
63 in
|
cannam@167
|
64 Fft.dft 1 fourn input'
|
cannam@167
|
65
|
cannam@167
|
66 let trigIII n input =
|
cannam@167
|
67 let fourn = 4 * n in
|
cannam@167
|
68 let twon = 2 * n in
|
cannam@167
|
69 let input' = Complex.hermitian fourn
|
cannam@167
|
70 (fun i ->
|
cannam@167
|
71 if (i == 0) then
|
cannam@167
|
72 Complex.real (input 0)
|
cannam@167
|
73 else if (i == twon) then
|
cannam@167
|
74 Complex.uminus (Complex.real (input 0))
|
cannam@167
|
75 else
|
cannam@167
|
76 Complex.antihermitian twon input i)
|
cannam@167
|
77 in
|
cannam@167
|
78 let dft = Fft.dft 1 fourn input'
|
cannam@167
|
79 in fun k -> dft (2 * k + 1)
|
cannam@167
|
80
|
cannam@167
|
81 let zero_extend n input = fun i ->
|
cannam@167
|
82 if (i >= 0 && i < n)
|
cannam@167
|
83 then input i
|
cannam@167
|
84 else Complex.zero
|
cannam@167
|
85
|
cannam@167
|
86 let trigIV n input =
|
cannam@167
|
87 let fourn = 4 * n
|
cannam@167
|
88 and eightn = 8 * n in
|
cannam@167
|
89 let input' = Complex.hermitian eightn
|
cannam@167
|
90 (zero_extend fourn (Complex.antihermitian fourn
|
cannam@167
|
91 (interleave_zero input)))
|
cannam@167
|
92 in
|
cannam@167
|
93 let dft = Fft.dft 1 eightn input'
|
cannam@167
|
94 in fun k -> dft (2 * k + 1)
|
cannam@167
|
95
|
cannam@167
|
96 let make_dct scale nshift trig =
|
cannam@167
|
97 fun n input ->
|
cannam@167
|
98 trig (n - nshift) (Complex.real @@ (Complex.times scale) @@
|
cannam@167
|
99 (zero_extend n input))
|
cannam@167
|
100 (*
|
cannam@167
|
101 * DCT-I: y[k] = sum x[j] cos(pi * j * k / n)
|
cannam@167
|
102 *)
|
cannam@167
|
103 let dctI = make_dct Complex.one 1 trigI
|
cannam@167
|
104
|
cannam@167
|
105 (*
|
cannam@167
|
106 * DCT-II: y[k] = sum x[j] cos(pi * (j + 1/2) * k / n)
|
cannam@167
|
107 *)
|
cannam@167
|
108 let dctII = make_dct Complex.one 0 trigII
|
cannam@167
|
109
|
cannam@167
|
110 (*
|
cannam@167
|
111 * DCT-III: y[k] = sum x[j] cos(pi * j * (k + 1/2) / n)
|
cannam@167
|
112 *)
|
cannam@167
|
113 let dctIII = make_dct Complex.half 0 trigIII
|
cannam@167
|
114
|
cannam@167
|
115 (*
|
cannam@167
|
116 * DCT-IV y[k] = sum x[j] cos(pi * (j + 1/2) * (k + 1/2) / n)
|
cannam@167
|
117 *)
|
cannam@167
|
118 let dctIV = make_dct Complex.half 0 trigIV
|
cannam@167
|
119
|
cannam@167
|
120 let shift s input = fun i -> input (i - s)
|
cannam@167
|
121
|
cannam@167
|
122 (* DST-x input := TRIG-x (input / i) *)
|
cannam@167
|
123 let make_dst scale nshift kshift jshift trig =
|
cannam@167
|
124 fun n input ->
|
cannam@167
|
125 Complex.real @@
|
cannam@167
|
126 (shift (- jshift)
|
cannam@167
|
127 (trig (n + nshift) (Complex.uminus @@
|
cannam@167
|
128 (Complex.times Complex.i) @@
|
cannam@167
|
129 (Complex.times scale) @@
|
cannam@167
|
130 Complex.real @@
|
cannam@167
|
131 (shift kshift (zero_extend n input)))))
|
cannam@167
|
132
|
cannam@167
|
133 (*
|
cannam@167
|
134 * DST-I: y[k] = sum x[j] sin(pi * j * k / n)
|
cannam@167
|
135 *)
|
cannam@167
|
136 let dstI = make_dst Complex.one 1 1 1 trigI
|
cannam@167
|
137
|
cannam@167
|
138 (*
|
cannam@167
|
139 * DST-II: y[k] = sum x[j] sin(pi * (j + 1/2) * k / n)
|
cannam@167
|
140 *)
|
cannam@167
|
141 let dstII = make_dst Complex.one 0 0 1 trigII
|
cannam@167
|
142
|
cannam@167
|
143 (*
|
cannam@167
|
144 * DST-III: y[k] = sum x[j] sin(pi * j * (k + 1/2) / n)
|
cannam@167
|
145 *)
|
cannam@167
|
146 let dstIII = make_dst Complex.half 0 1 0 trigIII
|
cannam@167
|
147
|
cannam@167
|
148 (*
|
cannam@167
|
149 * DST-IV y[k] = sum x[j] sin(pi * (j + 1/2) * (k + 1/2) / n)
|
cannam@167
|
150 *)
|
cannam@167
|
151 let dstIV = make_dst Complex.half 0 0 0 trigIV
|
cannam@167
|
152
|