File Coverage

blib/lib/MDK/Common/Math.pm
Criterion Covered Total %
statement 3 70 4.2
branch 0 8 0.0
condition 0 19 0.0
subroutine 1 21 4.7
pod 20 20 100.0
total 24 138 17.3


line stmt bran cond sub pod time code
1             package MDK::Common::Math;
2              
3             =head1 NAME
4              
5             MDK::Common::Math - miscellaneous math functions
6              
7             =head1 SYNOPSIS
8              
9             use MDK::Common::Math qw(:all);
10              
11             =head1 EXPORTS
12              
13             =over
14              
15             =item $PI
16              
17             the well-known constant
18              
19             =item even(INT)
20              
21             =item odd(INT)
22              
23             is the number even or odd?
24              
25             =item sqr(FLOAT)
26              
27             C gives C<9>
28              
29             =item sign(FLOAT)
30              
31             returns a value in { -1, 0, 1 }
32              
33             =item round(FLOAT)
34              
35             C gives C<1>, C gives C<2>
36              
37             =item round_up(FLOAT, INT)
38              
39             returns the number rounded up to the modulo:
40             C gives C<20>
41              
42             =item round_down(FLOAT, INT)
43              
44             returns the number rounded down to the modulo:
45             C gives C<10>
46              
47             =item divide(INT, INT)
48              
49             integer division (which is lacking in perl). In array context, also returns the remainder:
50             C<($a, $b) = divide(10,3)> gives C<$a is 3> and C<$b is 1>
51              
52             =item min(LIST)
53              
54             =item max(LIST)
55              
56             returns the minimum/maximum number in the list
57              
58             =item or_(LIST)
59              
60             is there a true value in the list?
61              
62             =item and_(LIST)
63              
64             are all values true in the list?
65              
66             =item sum(LIST)
67              
68             =item product(LIST)
69              
70             returns the sum/product of all the element in the list
71              
72             =item factorial(INT)
73              
74             C gives C<24> (4*3*2)
75              
76             =back
77              
78             =head1 OTHER
79              
80             the following functions are provided, but not exported:
81              
82             =over
83              
84             =item factorize(INT)
85              
86             C gives C<([2,3], [5,1])> as S<40 = 2^3 + 5^1>
87              
88             =item decimal2fraction(FLOAT)
89              
90             C gives C<(4, 3)>
91             ($PRECISION is used to decide which precision to use)
92              
93             =item poly2(a,b,c)
94              
95             Solves the a*x2+b*x+c=0 polynomial:
96             C gives C<(1, -1)>
97              
98             =item permutations(n,p)
99              
100             A(n,p)
101              
102             =item combinaisons(n,p)
103              
104             C(n,p)
105              
106             =back
107              
108             =head1 SEE ALSO
109              
110             L
111              
112             =cut
113              
114              
115 1     1   6 use Exporter;
  1         1  
  1         707  
116             our @ISA = qw(Exporter);
117             our @EXPORT_OK = qw($PI even odd sqr sign round round_up round_down divide min max or_ and_ sum product factorial);
118             our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
119              
120              
121             our $PRECISION = 10;
122             our $PI = 3.1415926535897932384626433832795028841972;
123              
124 0     0 1   sub even { $_[0] % 2 == 0 }
125 0     0 1   sub odd { $_[0] % 2 == 1 }
126 0     0 1   sub sqr { $_[0] * $_[0] }
127 0     0 1   sub sign { $_[0] <=> 0 }
128 0     0 1   sub round { int($_[0] + 0.5) }
129 0   0 0 1   sub round_up { my ($i, $r) = @_; $r ||= 1; $i = int $i; $i += $r - ($i + $r - 1) % $r - 1 }
  0            
  0            
  0            
130 0   0 0 1   sub round_down { my ($i, $r) = @_; $r ||= 1; $i = int $i; $i -= $i % $r }
  0            
  0            
  0            
131 0 0   0 1   sub divide { my $d = int $_[0] / $_[1]; wantarray() ? ($d, $_[0] % $_[1]) : $d }
  0            
132 0   0 0 1   sub min { my $n = shift; $_ < $n and $n = $_ foreach @_; $n }
  0            
  0            
133 0   0 0 1   sub max { my $n = shift; $_ > $n and $n = $_ foreach @_; $n }
  0            
  0            
134 0   0 0 1   sub or_ { my $n = 0; $n ||= $_ foreach @_; $n }
  0            
  0            
135 0   0 0 1   sub and_ { my $n = 1; $n &&= $_ foreach @_; $n }
  0            
  0            
136 0     0 1   sub sum { my $n = 0; $n += $_ foreach @_; $n }
  0            
  0            
137 0     0 1   sub product { my $n = 1; $n *= $_ foreach @_; $n }
  0            
  0            
138              
139              
140             sub factorize {
141 0     0 1   my ($n) = @_;
142 0           my @r;
143              
144 0 0         $n == 1 and return [ 1, 1 ];
145 0           for (my $k = 2; sqr($k) <= $n; $k++) {
146 0           my $i = 0;
147 0           for ($i = 0; $n % $k == 0; $i++) { $n /= $k }
  0            
148 0 0         $i and push @r, [ $k, $i ];
149             }
150 0 0         $n > 1 and push @r, [ $n, 1 ];
151 0           @r;
152             }
153              
154             sub decimal2fraction { # ex: 1.33333333 -> (4, 3)
155 0     0 1   my $n0 = shift;
156 0   0       my $precision = 10 ** -(shift || $PRECISION);
157 0           my ($a, $b) = (int $n0, 1);
158 0           my ($c, $d) = (1, 0);
159 0           my $n = $n0 - int $n0;
160 0           my $k;
161 0           until (abs($n0 - $a / $c) < $precision) {
162 0           $n = 1 / $n;
163 0           $k = int $n;
164 0           ($a, $b) = ($a * $k + $b, $a);
165 0           ($c, $d) = ($c * $k + $d, $c);
166 0           $n -= $k;
167             }
168 0           ($a, $c);
169             }
170              
171             sub poly2 {
172 0     0 1   my ($a, $b, $c) = @_;
173 0           my $d = ($b**2 - 4 * $a * $c) ** 0.5;
174 0           (-$b + $d) / 2 / $a, (-$b - $d) / 2 / $a;
175             }
176              
177             # A(n,p)
178             sub permutations {
179 0     0 1   my ($n, $p) = @_;
180 0           my ($r, $i);
181 0           for ($r = 1, $i = 0; $i < $p; $i++) {
182 0           $r *= $n - $i;
183             }
184 0           $r;
185             }
186              
187             # C(n,p)
188             sub combinaisons {
189 0     0 1   my ($n, $p) = @_;
190              
191 0           permutations($n, $p) / factorial($p);
192             }
193              
194 0     0 1   sub factorial { permutations($_[0], $_[0]) }
195              
196              
197             1;