| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Math::DCT; |
|
2
|
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
661530
|
use 5.008; |
|
|
4
|
|
|
|
|
25
|
|
|
4
|
4
|
|
|
4
|
|
17
|
use strict; |
|
|
4
|
|
|
|
|
7
|
|
|
|
4
|
|
|
|
|
68
|
|
|
5
|
4
|
|
|
4
|
|
14
|
use warnings; |
|
|
4
|
|
|
|
|
9
|
|
|
|
4
|
|
|
|
|
229
|
|
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=encoding UTF-8 |
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 NAME |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Math::DCT - 1D and NxN 2D Fast Discreet Cosine Transforms (DCT-II) |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
use Math::DCT qw/dct dct1d dct2d idct1d idct2d/; |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my $dct1d = dct([[1,2,3,4]]); |
|
18
|
|
|
|
|
|
|
$dct1d = dct1d([1,2,3,4]); |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $dct2d = dct([[1,2],[3,4]]); |
|
21
|
|
|
|
|
|
|
$dct2d = dct2d([1,2,3,4]); |
|
22
|
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
my $idct1d = idct1d([1,2,3,4]); |
|
24
|
|
|
|
|
|
|
my $idct2d = idct2d([1,2,3,4]); |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 VERSION |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Version 0.04_01 |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=cut |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our $VERSION = '0.04_01'; |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
require XSLoader; |
|
35
|
|
|
|
|
|
|
XSLoader::load('Math::DCT', $VERSION); |
|
36
|
|
|
|
|
|
|
|
|
37
|
4
|
|
|
4
|
|
20
|
use Exporter qw(import); |
|
|
4
|
|
|
|
|
6
|
|
|
|
4
|
|
|
|
|
2967
|
|
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
|
40
|
|
|
|
|
|
|
dct |
|
41
|
|
|
|
|
|
|
dct1d |
|
42
|
|
|
|
|
|
|
dct2d |
|
43
|
|
|
|
|
|
|
idct1d |
|
44
|
|
|
|
|
|
|
idct2d |
|
45
|
|
|
|
|
|
|
); |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
our %EXPORT_TAGS; |
|
48
|
|
|
|
|
|
|
$EXPORT_TAGS{all} = [@EXPORT_OK]; |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
An unscaled DCT-II implementation for 1D and NxN 2D matrices implemented in XS. |
|
53
|
|
|
|
|
|
|
For array sizes which are a power of 2 a fast - I for 1D, I |
|
54
|
|
|
|
|
|
|
for 2D - algorithm (FCT) described by Lee is used with some tweaks. |
|
55
|
|
|
|
|
|
|
In addition, an unscaled version of the specially optimized Arai, Agui, Nakajima |
|
56
|
|
|
|
|
|
|
FCT is used for 1x8, 8x8 matrices. A less optimized algorithm is used for |
|
57
|
|
|
|
|
|
|
the generic case, so any 1D or square 2D matrix can be processed (I, |
|
58
|
|
|
|
|
|
|
I respectivelly). |
|
59
|
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
For convenience the inverse functions are provided (inverse DCT-II, usually called |
|
61
|
|
|
|
|
|
|
iDCT, is essentially a scaled DCT-III), with an implementation equivalent to the |
|
62
|
|
|
|
|
|
|
generic DCT-II case. |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
The module was written for a perceptual hash project that needed 32x32 DCT-II, and |
|
65
|
|
|
|
|
|
|
on a 2.5GHz i7 2015 Macbook Pro about 18000/s per thread are processed. |
|
66
|
|
|
|
|
|
|
The common 8x8 DCT-II uses a special path, (about 380000/s on that same CPU), |
|
67
|
|
|
|
|
|
|
although for most image/video applications that require 8x8 DCT there are much faster |
|
68
|
|
|
|
|
|
|
implementations (SIMD, approximations etc) that usually produce an already scaled result |
|
69
|
|
|
|
|
|
|
for the specific application. |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
None of the algorithms used on this module are approximate, the test suite verifies |
|
72
|
|
|
|
|
|
|
against a naive DCT-II implementation with a tolerance of 1e-08. |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head1 METHODS |
|
75
|
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head2 C |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
my $dct = dct([[1,2],[3,4]]); # Example for 2x2 2D matrix |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Pass an array (ref) of either a single array, or N x length-N arrays for 1D and NxN |
|
81
|
|
|
|
|
|
|
2D DCT-II calculation respectivelly. The output will be an arrayref of array(s) |
|
82
|
|
|
|
|
|
|
with the result of the transform. |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
It is a convenience function with some overhead, mainly in the case of NxN arrays |
|
85
|
|
|
|
|
|
|
which have to be flattened before processing - for already flat 2D data see L |
|
86
|
|
|
|
|
|
|
below. |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=cut |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub dct { |
|
91
|
19
|
|
|
19
|
1
|
3777
|
my $vector = shift; |
|
92
|
19
|
100
|
100
|
|
|
172
|
die "Expect array of array(s)" |
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
93
|
|
|
|
|
|
|
unless $vector && ref $vector eq 'ARRAY' |
|
94
|
|
|
|
|
|
|
&& $vector->[0] && ref $vector->[0] eq 'ARRAY'; |
|
95
|
|
|
|
|
|
|
|
|
96
|
15
|
|
|
|
|
29
|
my $dim = scalar(@$vector); |
|
97
|
15
|
|
|
|
|
22
|
my $sz = scalar(@{$vector->[0]}); |
|
|
15
|
|
|
|
|
42
|
|
|
98
|
15
|
100
|
100
|
|
|
60
|
die "Expect 1d or NxN 2d arrays" unless $dim == 1 || $dim == $sz; |
|
99
|
|
|
|
|
|
|
|
|
100
|
14
|
|
|
|
|
33
|
my $pack; |
|
101
|
14
|
|
|
|
|
37
|
for (my $x = 0; $x < $dim; $x++) { |
|
102
|
131
|
|
|
|
|
165
|
$pack .= pack "d$sz", @{$vector->[$x]} |
|
|
131
|
|
|
|
|
403
|
|
|
103
|
|
|
|
|
|
|
} |
|
104
|
|
|
|
|
|
|
|
|
105
|
14
|
100
|
|
|
|
49
|
if ($dim > 1) { |
|
106
|
7
|
100
|
|
|
|
673
|
$sz == 8 |
|
|
|
100
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
? fct8_2d($pack) |
|
108
|
|
|
|
|
|
|
: 0 == ($sz & ($sz - 1)) ? fast_dct_2d($pack, $sz) : dct_2d($pack, $sz); |
|
109
|
|
|
|
|
|
|
} else { |
|
110
|
7
|
100
|
|
|
|
61
|
$sz == 8 |
|
|
|
100
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
? fct8_1d($pack) |
|
112
|
|
|
|
|
|
|
: 0 == ($sz & ($sz - 1)) ? fast_dct_1d($pack, $sz) : dct_1d($pack, $sz); |
|
113
|
|
|
|
|
|
|
} |
|
114
|
|
|
|
|
|
|
|
|
115
|
14
|
|
|
|
|
20
|
my $result; |
|
116
|
14
|
|
|
|
|
37
|
foreach (0..$dim-1) { |
|
117
|
131
|
|
|
|
|
596
|
$result->[$_] = [unpack "d".($sz), substr $pack, $_ * $sz*8, $sz*8]; |
|
118
|
|
|
|
|
|
|
} |
|
119
|
14
|
|
|
|
|
40
|
return $result; |
|
120
|
|
|
|
|
|
|
} |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head2 C |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
my $dct = dct1d([1,2,3]); |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Pass an array (ref) for a 1D DCT-II calculation. The output will be an arrayref |
|
127
|
|
|
|
|
|
|
with the result of the transform. |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=cut |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub dct1d { |
|
132
|
7
|
|
|
7
|
1
|
572018
|
my $input = shift; |
|
133
|
7
|
|
|
|
|
12
|
my $sz = scalar @$input; |
|
134
|
7
|
|
|
|
|
40
|
my $pack = pack "d$sz", @$input; |
|
135
|
7
|
100
|
|
|
|
98
|
$sz == 8 |
|
|
|
100
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
? fct8_1d($pack) |
|
137
|
|
|
|
|
|
|
: 0 == ($sz & ($sz - 1)) ? fast_dct_1d($pack, $sz) : dct_1d($pack, $sz); |
|
138
|
7
|
|
|
|
|
35
|
my @result = unpack "d$sz", $pack; |
|
139
|
7
|
|
|
|
|
23
|
return \@result; |
|
140
|
|
|
|
|
|
|
} |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=head2 C |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
my $idct = idct1d([1,2,3]); |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Pass an array (ref) for a 1D iDCT-II calculation. The output will be an arrayref |
|
147
|
|
|
|
|
|
|
with the result of the transform. This is essentially a DCT-III transform scaled |
|
148
|
|
|
|
|
|
|
by 2/N. |
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=cut |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub idct1d { |
|
153
|
6
|
|
|
6
|
1
|
71353
|
my $input = shift; |
|
154
|
6
|
|
|
|
|
10
|
my $sz = scalar @$input; |
|
155
|
6
|
|
|
|
|
30
|
my $pack = pack "d$sz", @$input; |
|
156
|
6
|
|
|
|
|
296
|
idct_1d($pack, $sz); |
|
157
|
6
|
|
|
|
|
25
|
my @result = unpack "d$sz", $pack; |
|
158
|
6
|
|
|
|
|
18
|
return \@result; |
|
159
|
|
|
|
|
|
|
} |
|
160
|
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head2 C |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
my $dct = dct2d( |
|
164
|
|
|
|
|
|
|
[1,2,3,4], # Arrayref containing your NxN matrix |
|
165
|
|
|
|
|
|
|
2 # Optionally, the size N of your array (sqrt of its length) |
|
166
|
|
|
|
|
|
|
); |
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
Pass an array (ref) for a 2D DCT-II calculation. The length of the array is expected |
|
169
|
|
|
|
|
|
|
to be a square (as only NxN arrays are supported) - you can optionally pass N as |
|
170
|
|
|
|
|
|
|
the second argument to avoid a C calculation. |
|
171
|
|
|
|
|
|
|
The output will be an arrayref with the result of the transform. |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
If your 2D data is available in a 1D array as is usual with most image manipulation |
|
174
|
|
|
|
|
|
|
etc cases, this function will be faster than C, as the DCT calculation is |
|
175
|
|
|
|
|
|
|
in any case done on a 1D array, hence you save the cost of conversion. |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=cut |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub dct2d { |
|
180
|
10
|
|
|
10
|
1
|
636550
|
my $input = shift; |
|
181
|
10
|
|
100
|
|
|
57
|
my $sz = shift || sqrt(scalar @$input); |
|
182
|
9
|
|
|
|
|
387
|
my $pack = pack "d".($sz*$sz), @$input; |
|
183
|
9
|
100
|
|
|
|
715
|
$sz == 8 |
|
|
|
100
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
? fct8_2d($pack) |
|
185
|
|
|
|
|
|
|
: 0 == ($sz & ($sz - 1)) ? fast_dct_2d($pack, $sz) : dct_2d($pack, $sz); |
|
186
|
9
|
|
|
|
|
304
|
my @result = unpack "d".($sz*$sz), $pack; |
|
187
|
9
|
|
|
|
|
52
|
return \@result; |
|
188
|
|
|
|
|
|
|
} |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=head2 C |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
my $idct = idct2d( |
|
193
|
|
|
|
|
|
|
[1,2,3,4], # Arrayref containing your NxN matrix |
|
194
|
|
|
|
|
|
|
2 # Optionally, the size N of your array (sqrt of its length) |
|
195
|
|
|
|
|
|
|
); |
|
196
|
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
Pass an array (ref) for a 2D iDCT-II calculation. The length of the array is expected |
|
198
|
|
|
|
|
|
|
to be a square (as only NxN arrays are supported) - you can optionally pass N as |
|
199
|
|
|
|
|
|
|
the second argument to avoid a C calculation. |
|
200
|
|
|
|
|
|
|
This is essentially a DCT-III transform scaled by 2/N. |
|
201
|
|
|
|
|
|
|
The output will be an arrayref with the result of the transform. |
|
202
|
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=cut |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub idct2d { |
|
206
|
6
|
|
|
6
|
1
|
3150656
|
my $input = shift; |
|
207
|
6
|
|
33
|
|
|
34
|
my $sz = shift || sqrt(scalar @$input); |
|
208
|
6
|
|
|
|
|
193
|
my $pack = pack "d".($sz*$sz), @$input; |
|
209
|
6
|
|
|
|
|
2748
|
idct_2d($pack, $sz); |
|
210
|
6
|
|
|
|
|
259
|
my @result = unpack "d".($sz*$sz), $pack; |
|
211
|
6
|
|
|
|
|
45
|
return \@result; |
|
212
|
|
|
|
|
|
|
} |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head1 USAGE NOTES |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
The C functions are not exported, but theoretically you could use them directly |
|
217
|
|
|
|
|
|
|
if you do your own C. The fast versions for power-of-2 size arrays |
|
218
|
|
|
|
|
|
|
are C and C, while the generic versions are C |
|
219
|
|
|
|
|
|
|
and C (with their inverse functions being C and C). |
|
220
|
|
|
|
|
|
|
The specialized size-8 versions are C and C. |
|
221
|
|
|
|
|
|
|
First argument is a C (use C), second is the size N (except |
|
222
|
|
|
|
|
|
|
for the fct8* functions which don't need a second argument). |
|
223
|
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
C code for 1D DCT was adapted from Project Nayuki and improved where possible. |
|
227
|
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
(L) |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 AUTHOR |
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Dimitrios Kechagias, C<< >> |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head1 BUGS |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Please report any bugs or feature requests either on GitHub, or on RT (via the email |
|
237
|
|
|
|
|
|
|
C or web interface at L). |
|
238
|
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
I will be notified, and then you'll be notified of progress on your bug as I make changes. |
|
240
|
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=head1 GIT |
|
242
|
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
L |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
|
246
|
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
Copyright (C) 2019, SpareRoom.com |
|
248
|
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
This program is free software; you can redistribute |
|
250
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
|
251
|
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=cut |
|
253
|
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
1; |