File Coverage

blib/lib/Statistics/QuickMedian.pm
Criterion Covered Total %
statement 9 35 25.7
branch 0 6 0.0
condition n/a
subroutine 3 5 60.0
pod 2 2 100.0
total 14 48 29.1


line stmt bran cond sub pod time code
1             package Statistics::QuickMedian;
2              
3 1     1   24931 use 5.006;
  1         5  
  1         68  
4 1     1   6 use strict;
  1         2  
  1         39  
5 1     1   18 use warnings FATAL => 'all';
  1         15  
  1         442  
6             require Exporter;
7             our @ISA = qw/Exporter/;
8             our @EXPORT_OK = qw/qmedian/;
9              
10             =head1 NAME
11              
12             Statistics::QuickMedian - Parition-based median estimator
13              
14             =head1 VERSION
15              
16             Version 0.03
17              
18             =cut
19              
20             our $VERSION = '0.03';
21              
22              
23             =head1 SYNOPSIS
24              
25             CAR Hoare's partition-based Quick Median Estimator in perl
26              
27              
28             use Statistics::QuickMedian qw/qmedian/;
29             my $median = qmedian(\$array);
30              
31             #or
32             use Statistics::QuickMedian;
33             my $qm = Statistics::QuickMedian->new();
34             my $median = $qm->qmedian(\$array);
35            
36            
37             =head1 EXPORT
38              
39             =over
40              
41             =item qmedian
42              
43             use Statistics::QuickMedian qw/qmedian/;
44              
45             =back
46              
47             =head1 SUBROUTINES/METHODS
48              
49             =head2 new
50              
51             Makes a new Statistics::QuickMedian object...
52              
53             use Statistics::QuickMedian;
54             my $qm = Statistics::QuickMedian->new();
55              
56             =head2 qmedian(arrayref)
57              
58             Partitions the data in referenced array and returns the median.
59              
60             my $median = $qm->qmedian(\$array);
61             # or
62             my $median = qmedian(\$array);
63              
64             =cut
65              
66             sub qmedian {
67 0     0 1   my $a = pop; # leave object intact if it's there... total cheat!
68 0           my $n = @$a;
69 0           my $L = 0;
70 0           my $R = $n-1;
71 0           my $k = int($n / 2);
72 0           my ($i, $j);
73 0           while ($L < $R){
74 0           my $x = $a->[$k];
75 0           $i = $L; $j = $R;
  0            
76 0           qsplit($n, $x, \$i, \$j, $a);
77 0 0         if ($j < $k){ $L = $i; }
  0            
78 0 0         if ($k < $i){ $R = $j; }
  0            
79             }
80 0           return $a->[$k];
81             }
82              
83             =head2 qsplit
84              
85             Used by qmedian.
86              
87             =cut
88              
89             sub qsplit {
90 0     0 1   my ($n, $x, $i, $j, $a) = @_;
91 0           do {
92 0           while ($a->[$$i] < $x){ $$i++; }
  0            
93 0           while ($x < $a->[$$j]){ $$j--; }
  0            
94 0 0         if ($$i <= $$j){
95 0           ($a->[$$i], $a->[$$j]) = ($a->[$$j], $a->[$$i]);
96 0           $$i++; $$j--;
  0            
97             }
98             }
99             while ($$i <= $$j);
100             }
101              
102             =head1 AUTHOR
103              
104             Jimi Wills, C<< >>
105              
106             =head1 BUGS
107              
108             Please report any bugs or feature requests to C, or through
109             the web interface at L. I will be notified, and then you'll
110             automatically be notified of progress on your bug as I make changes.
111              
112              
113              
114              
115             =head1 SUPPORT
116              
117             You can find documentation for this module with the perldoc command.
118              
119             perldoc Statistics::QuickMedian
120              
121              
122             You can also look for information at:
123              
124             =over 4
125              
126             =item * RT: CPAN's request tracker (report bugs here)
127              
128             L
129              
130             =item * AnnoCPAN: Annotated CPAN documentation
131              
132             L
133              
134             =item * CPAN Ratings
135              
136             L
137              
138             =item * Search CPAN
139              
140             L
141              
142             =back
143              
144              
145             =head1 ACKNOWLEDGEMENTS
146              
147             L
148              
149             C.A.R. Hoare.
150              
151             =head1 LICENSE AND COPYRIGHT
152              
153             Copyright 2013 Jimi Wills.
154              
155             This program is free software; you can redistribute it and/or modify it
156             under the terms of the the Artistic License (2.0). You may obtain a
157             copy of the full license at:
158              
159             L
160              
161             Any use, modification, and distribution of the Standard or Modified
162             Versions is governed by this Artistic License. By using, modifying or
163             distributing the Package, you accept this license. Do not use, modify,
164             or distribute the Package, if you do not accept this license.
165              
166             If your Modified Version has been derived from a Modified Version made
167             by someone other than you, you are nevertheless required to ensure that
168             your Modified Version complies with the requirements of this license.
169              
170             This license does not grant you the right to use any trademark, service
171             mark, tradename, or logo of the Copyright Holder.
172              
173             This license includes the non-exclusive, worldwide, free-of-charge
174             patent license to make, have made, use, offer to sell, sell, import and
175             otherwise transfer the Package with respect to any patent claims
176             licensable by the Copyright Holder that are necessarily infringed by the
177             Package. If you institute patent litigation (including a cross-claim or
178             counterclaim) against any party alleging that the Package constitutes
179             direct or contributory patent infringement, then this Artistic License
180             to you shall terminate on the date that such litigation is filed.
181              
182             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
183             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
184             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
185             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
186             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
187             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
188             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
189             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
190              
191              
192             =cut
193              
194             1; # End of Statistics::QuickMedian