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             our $AUTHORITY = 'cpan:GENE';
3             # ABSTRACT: Combinatorial counting operations
4              
5             our $VERSION = '0.1307';
6              
7 3     3   1880 use strict;
  3         6  
  3         72  
8 3     3   11 use warnings;
  3         6  
  3         73  
9              
10             # Export either "student" or "engineering" methods.
11 3     3   1025 use parent qw(Exporter);
  3         765  
  3         13  
12             our %EXPORT_TAGS = (
13             student => [qw( factorial permutation combination )],
14             big => [qw( bfact bperm bcomb bderange )],
15             );
16             our @EXPORT_OK = qw(
17             factorial permutation combination
18             bfact bperm bcomb
19             bderange
20             );
21             our @EXPORT = ();
22              
23             # Try to use a math processor.
24 3     3   2822 use Math::BigFloat try => 'GMP,Pari'; # Used for derangement computation only.
  3         130836  
  3         17  
25 3     3   59139 use Math::BigInt try => 'GMP,Pari';
  3         5  
  3         11  
26              
27              
28             sub factorial {
29 8     8 1 3236 my $n = shift;
30 8 100 100     55 return unless defined $n && $n =~ /^\d+$/;
31 6         12 my $product = 1;
32 6         12 while( $n > 0 ) {
33 243         312 $product *= $n--;
34             }
35 6         25 return $product;
36             }
37              
38              
39             sub bfact {
40 7     7 1 4029 my $n = shift;
41 7         22 $n = Math::BigInt->new($n);
42 7         371 return $n->bfac;
43             }
44              
45              
46             sub permutation {
47 10     10 1 5615 my( $n, $k ) = @_;
48 10 100 66     95 return unless defined $n && $n =~ /^\d+$/ && defined $k && $k =~ /^\d+$/;
      66        
      100        
49 8         14 my $product = 1;
50 8         14 while( $k > 0 ) {
51 140         141 $product *= $n--;
52 140         170 $k--;
53             }
54 8         40 return $product;
55             }
56              
57              
58             sub bperm {
59 20     20 1 16329 my( $n, $k, $r ) = @_;
60 20         55 $n = Math::BigInt->new($n);
61 20         1051 $k = Math::BigInt->new($k);
62             # With repetitions?
63 20 100       849 if ($r) {
64 10         27 return $n->bpow($k);
65             }
66             else {
67 10         29 $k = $n - $k;
68 10         874 return $n->bfac / $k->bfac;
69             }
70             }
71              
72              
73             sub bderange {
74 7     7 1 6507 my $n = shift;
75 7         26 my $mone = Math::BigFloat->bone('-'); # -1
76 7         291 my $s = Math::BigFloat->bzero;
77 7         156 for ( 0 .. $n ) {
78 59         38575 my $i = Math::BigFloat->new($_);
79 59         4461 my $m = $mone->copy;
80 59         1270 my $j = $m->bpow($i);
81 59         7066 my $x = $i->copy;
82 59         1211 my $f = $x->bfac;
83 59         8005 $s += $j / $f;
84             }
85 7         4669 $n = Math::BigFloat->new($n);
86 7         579 return $n->bfac * $s;
87             }
88              
89              
90             sub combination {
91 11     11 1 4353 my( $n, $k ) = @_;
92 11 100 66     101 return unless defined $n && $n =~ /^\d+$/ && defined $k && $k =~ /^\d+$/;
      66        
      100        
93 8         14 my $product = 1;
94 8         14 while( $k > 0 ) {
95 140         143 $product *= $n--;
96 140         184 $product /= $k--;
97             }
98 8         30 return $product;
99             }
100              
101              
102             sub bcomb {
103 22     22 1 20762 my( $n, $k, $r ) = @_;
104 22         64 $n = Math::BigInt->new($n);
105 22         1118 $k = Math::BigInt->new($k);
106             # With repetitions?
107 22 100       936 if ($r) {
108 11         26 my $c1 = $n + $k - 1;
109 11         2434 my $c2 = $n - 1;
110 11         3135 return $c1->bfac / ($k->bfac * $c2->bfac);
111             }
112             else {
113 11         29 my $c1 = $n - $k;
114 11         1023 return $n->bfac / ($k->bfac * $c1->bfac);
115             }
116             }
117              
118             1;
119              
120             __END__