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; |