File Coverage

blib/lib/Math/Counting.pm
Criterion Covered Total %
statement 66 66 100.0
branch 10 10 100.0
condition 17 21 80.9
subroutine 12 12 100.0
pod 7 7 100.0
total 112 116 96.5


line stmt bran cond sub pod time code
1             package Math::Counting;
2             # ABSTRACT: Combinatorial counting operations
3              
4             our $VERSION = '0.1304';
5              
6 4     4   27369 use strict;
  4         8  
  4         284  
7 4     4   88 use warnings;
  4         9  
  4         152  
8              
9             # Export either "student" or "engineering" methods.
10 4     4   3708 use parent qw(Exporter);
  4         1403  
  4         23  
11             our %EXPORT_TAGS = (
12             student => [qw( factorial permutation combination )],
13             big => [qw( bfact bperm bcomb bderange )],
14             );
15             our @EXPORT_OK = qw(
16             factorial permutation combination
17             bfact bperm bcomb
18             bderange
19             );
20             our @EXPORT = ();
21              
22             # Try to use a math processor.
23 4     4   7284 use Math::BigFloat try => 'GMP,Pari'; # Used for derangement computation only.
  4         148555  
  4         26  
24 4     4   242052 use Math::BigInt try => 'GMP,Pari';
  4         11  
  4         20  
25              
26              
27             sub factorial {
28 8     8 1 3775 my $n = shift;
29 8 100 100     67 return unless defined $n && $n =~ /^\d+$/;
30 6         13 my $product = 1;
31 6         17 while( $n > 0 ) {
32 243         454 $product *= $n--;
33             }
34 6         39 return $product;
35             }
36              
37              
38             sub bfact {
39 7     7 1 3323 my $n = shift;
40 7         28 $n = Math::BigInt->new($n);
41 7         367 return $n->bfac;
42             }
43              
44              
45             sub permutation {
46 11     11 1 6371 my( $n, $k ) = @_;
47 11 100 66     151 return unless defined $n && $n =~ /^\d+$/ && defined $k && $k =~ /^\d+$/;
      66        
      100        
48 8         11 my $product = 1;
49 8         18 while( $k > 0 ) {
50 140         138 $product *= $n--;
51 140         194 $k--;
52             }
53 8         50 return $product;
54             }
55              
56              
57             sub bperm {
58 22     22 1 16397 my( $n, $k, $r ) = @_;
59 22         81 $n = Math::BigInt->new($n);
60 22         1182 $k = Math::BigInt->new($k);
61             # With repetitions?
62 22 100       947 if ($r) {
63 11         37 return $n->bpow($k);
64             }
65             else {
66 11         35 $k = $n - $k;
67 11         6294 return $n->bfac / $k->bfac;
68             }
69             }
70              
71              
72             sub bderange {
73 7     7 1 6818 my $n = shift;
74 7         52 my $mone = Math::BigFloat->bone('-'); # -1
75 7         345 my $s = Math::BigFloat->bzero;
76 7         204 for ( 0 .. $n ) {
77 59         35356 my $i = Math::BigFloat->new($_);
78 59         4201 my $m = $mone->copy;
79 59         1281 my $j = $m->bpow($i);
80 59         7709 my $x = $i->copy;
81 59         1103 my $f = $x->bfac;
82 59         8372 $s += $j / $f;
83             }
84 7         7169 $n = Math::BigFloat->new($n);
85 7         570 return $n->bfac * $s;
86             }
87              
88              
89             sub combination {
90 11     11 1 12054 my( $n, $k ) = @_;
91 11 100 66     261 return unless defined $n && $n =~ /^\d+$/ && defined $k && $k =~ /^\d+$/;
      66        
      100        
92 8         11 my $product = 1;
93 8         349 while( $k > 0 ) {
94 140         744 $product *= $n--;
95 140         409 $product /= $k--;
96             }
97 8         34 return $product;
98             }
99              
100              
101             sub bcomb {
102 22     22 1 27508 my( $n, $k, $r ) = @_;
103 22         92 $n = Math::BigInt->new($n);
104 22         1581 $k = Math::BigInt->new($k);
105             # With repetitions?
106 22 100       1009 if ($r) {
107 11         45 my $c1 = $n + $k - 1;
108 11         3022 my $c2 = $n - 1;
109 11         2410 return $c1->bfac / ($k->bfac * $c2->bfac);
110             }
111             else {
112 11         35 my $c1 = $n - $k;
113 11         1594 return $n->bfac / ($k->bfac * $c1->bfac);
114             }
115             }
116              
117             1;
118              
119             __END__