File Coverage

blib/lib/Math/DCT.pm
Criterion Covered Total %
statement 52 52 100.0
branch 22 22 100.0
condition 16 18 88.8
subroutine 9 9 100.0
pod 5 5 100.0
total 104 106 98.1


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;