File Coverage

blib/lib/Math/Polynomial/Horner.pm
Criterion Covered Total %
statement 166 170 97.6
branch 53 60 88.3
condition 48 66 72.7
subroutine 18 18 100.0
pod 1 1 100.0
total 286 315 90.7


line stmt bran cond sub pod time code
1             # Copyright 2007, 2008, 2009, 2010, 2011 Kevin Ryde
2              
3             # This file is part of Math-Polynomial-Horner.
4             #
5             # Math-Polynomial-Horner is free software; you can redistribute it and/or
6             # modify it under the terms of the GNU General Public License as published
7             # by the Free Software Foundation; either version 3, or (at your option) any
8             # later version.
9             #
10             # Math-Polynomial-Horner is distributed in the hope that it will be useful,
11             # but WITHOUT ANY WARRANTY; without even the implied warranty of
12             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
13             # Public License for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Math-Polynomial-Horner. If not, see .
17              
18             package Math::Polynomial::Horner;
19 1     1   1837 use 5.006;
  1         4  
  1         49  
20 1     1   6 use strict;
  1         2  
  1         155  
21 1     1   17 use warnings;
  1         1  
  1         45  
22 1     1   6 use vars '$VERSION';
  1         2  
  1         277  
23              
24             # uncomment this to run the ### lines
25             #use Smart::Comments;
26              
27             $VERSION = 3;
28              
29             sub _stringize {
30 262     262   2506 return "$_[0]";
31             }
32              
33 1         128 use constant _config_defaults =>
34             (ascending => 0,
35             with_variable => 1,
36             fold_sign => 0,
37             fold_zero => 1,
38             fold_one => 1,
39             fold_exp_zero => 1,
40             fold_exp_one => 1,
41             convert_coeff => \&_stringize,
42             plus => q{ + },
43             minus => q{ - },
44             leading_plus => q{},
45             leading_minus => q{- },
46             times => q{ },
47             power => q{^},
48             variable => q{x},
49             prefix => q{(},
50             suffix => q{)},
51              
52             # extras
53             left_paren => '(',
54             right_paren => ')',
55              
56             # secret extras
57             fold_sign_swap_end => 0,
58             power_by_times_upto => 0,
59 1     1   7 );
  1         1  
60              
61 1         309 use constant _config_perl =>
62             (fold_sign => 1,
63             fold_sign_swap_end => 1,
64             leading_minus => q{-},
65             power => q{**},
66 1     1   6 power_by_times_upto => 3);
  1         1  
67              
68 1     1   6 use constant _EMPTY => 0;
  1         2  
  1         56  
69 1     1   5 use constant _FACTOR => 1;
  1         2  
  1         244  
70 1     1   5 use constant _SUM => 2;
  1         2  
  1         2953  
71              
72             sub as_string {
73 168     168 1 153873 my ($poly, $string_config) = @_;
74 168         426 my $degree = $poly->degree;
75             ### $degree
76              
77 168   33     1100 $string_config ||= ($poly->string_config
      33        
78             || (ref $poly)->string_config);
79 168         1653 my %config = do {
80 168 50       3622 (_config_defaults(),
81             ($string_config->{'for_perl'} ? _config_perl() : ()),
82             %$string_config)
83             };
84              
85 168 100       631 if ($degree <= 0) {
86             ### empty or constant
87 35         111 return $poly->as_string(\%config);
88             }
89              
90 133         387 my $zero = $poly->coeff_zero;
91 133         605 my $one = $poly->coeff_one;
92 133         568 my $convert = $config{'convert_coeff'};
93 133         177 my $ret = '';
94 133         157 my $pre = '';
95 133         136 my $post = '';
96 133         176 my $last = _EMPTY;
97              
98             my $leading_const = sub {
99 26     26   32 my ($coeff) = @_;
100             ### leading_const: "$coeff"
101 26 50 66     77 if ($config{'fold_sign'} && $coeff < $zero) {
102 0         0 $ret .= $config{'leading_minus'};
103 0         0 $coeff = -$coeff;
104             } else {
105 26         42 $ret .= $config{'leading_plus'};
106             }
107 26         44 $ret .= $convert->($coeff);
108 26         51 $last = _FACTOR;
109 133         655 };
110              
111             my $leading_factor = sub {
112 102     102   149 my ($coeff) = @_;
113             ### leading_factor: "$coeff"
114 102         117 my $pm = '';
115 102 100 100     309 if ($config{'fold_sign'} && $coeff < $zero) {
116 26         46 $ret .= $config{'leading_minus'};
117 26         36 $coeff = -$coeff;
118             } else {
119 76         127 $ret .= $config{'leading_plus'};
120             }
121 102 100 100     357 if ($config{'fold_one'} && $coeff == $one) {
122             ### fold_one skip to ret: $ret
123 26         32 $last = _EMPTY;
124 26         44 return;
125             }
126 76         148 $ret .= $pm . $convert->($coeff);
127 76         268 $last = _FACTOR;
128             ### gives ret: $ret
129 133         458 };
130              
131             my $times_coeff = sub {
132 22     22   30 my ($coeff) = @_;
133             ### times_coeff: "$coeff"
134 22 50 66     82 if ($config{'fold_one'}
135             && $coeff == $one) {
136             ### fold_one skip
137 0         0 return;
138             }
139 22 50       49 if ($last ne _EMPTY) {
140 22         36 $ret .= $config{'times'};
141             }
142 22         51 $ret .= $convert->($coeff);
143 22         38 $last = _FACTOR;
144             ### times_coeff gives ret: $ret
145 133         388 };
146              
147             my $plus_coeff = sub {
148 103     103   148 my ($coeff) = @_;
149 103 100 100     317 if ($config{'fold_sign'} && $coeff < $zero) {
150 23         30 $ret .= $config{'minus'};
151 23         30 $coeff = -$coeff;
152             } else {
153 80         108 $ret .= $config{'plus'};
154             }
155 103         176 $ret .= $convert->($coeff);
156 103         336 $last = _SUM;
157 133         370 };
158              
159 133         245 my $xpow = 0;
160             my $show_xpow = sub {
161             ### show_xpow: $xpow
162 155 100   155   329 return if ($xpow == 0);
163 154         186 $ret .= $config{'variable'};
164 154 100 66     613 if ($xpow == 1 && $config{'fold_exp_one'}) {
    100          
165             # x^1 -> x
166             } elsif ($xpow <= $config{'power_by_times_upto'}) {
167             # x*x*...*x
168 11         36 $ret .= ($config{'times'} . $config{'variable'}) x ($xpow-1);
169             } else {
170             # x^123
171 40         85 $ret .= $config{'power'} . $xpow;
172             }
173 154         166 $xpow = 0;
174 154         178 $last = _FACTOR;
175 133         384 };
176              
177             my $times_xpow = sub {
178             ### times_xpow: $xpow, $ret
179 207 100   207   416 if ($xpow) {
180 120 100       245 if ($last eq _SUM) {
181 14         44 $pre .= $config{'left_paren'};
182 14         19 $ret .= $config{'right_paren'};
183 14         16 $last = _FACTOR;
184             }
185 120 100       264 if ($last ne _EMPTY) {
186 94         204 $ret .= $config{'times'};
187             }
188 120         193 $show_xpow->();
189 120         151 $last = _FACTOR;
190             }
191             ### times_xpow gives: "pre=$pre ret=$ret"
192 133         380 };
193              
194 133 100       272 if ($config{'ascending'}) {
195             ### ascending
196              
197 29         36 my $limit = $degree;
198             {
199 29         30 my ($j, $high, $second);
  29         31  
200 29 50 100     102 if ($config{'fold_sign'} && $config{'fold_sign_swap_end'}
      66        
      66        
      33        
201             && ($high = $poly->coeff($degree)) > $zero
202             && (($j,$second) = _second_highest_coeff($poly,$config{'fold_zero'}))
203             && $second < $zero) {
204 2         5 $leading_const->($high);
205 2         2 $last = _FACTOR;
206              
207 2         5 $xpow = $degree - $j;
208 2         4 $times_xpow->();
209              
210 2         5 $plus_coeff->($second);
211 2         2 $limit = $j - 1;
212 2         4 $post = $ret;
213 2 100       6 if ($limit >= 0) {
214 1         4 $post = $config{'times'}
215             . $config{'left_paren'} . $post . $config{'right_paren'};
216             }
217 2         3 $ret = '';
218 2         4 $last = _EMPTY;
219             ### fold_sign_swap_end gives
220             ### $post
221             ### $limit
222             }
223             }
224              
225 29         36 $xpow = -1;
226 29         60 foreach my $i (0 .. $limit) {
227             ### $i
228 117         114 $xpow++;
229 117         273 my $coeff = $poly->coeff($i);
230 117 100 66     1118 if ($config{'fold_zero'} && $coeff == $zero) {
231 68         100 next;
232             }
233              
234 49 100       90 if ($xpow) {
235 33 100       64 if (length($ret)) {
236 21 100 100     92 if ($i == $degree
      66        
237             && $config{'fold_sign'}
238             && $coeff < $zero) {
239             ### highest coeff fold ... + x*-5 -> ... - x*5
240 2         3 $coeff = - $coeff;
241 2         5 $ret .= $config{'minus'};
242             } else {
243             # other coeffs ... + x*(...) or highest ... + x*5
244 19         34 $ret .= $config{'plus'};
245             }
246             }
247 33         52 $show_xpow->();
248 33 100       71 if ($i == $degree) {
249 27 100 100     109 if ($config{'fold_one'}
250             && $coeff == $one) {
251             ### highest coeff x*1 -> x
252             } else {
253             ### highest coeff: "$coeff"
254 22         39 $times_coeff->($coeff);
255             }
256 27         38 last;
257             }
258 6         9 $ret .= $config{'times'} . $config{'left_paren'};
259 6         13 $post .= $config{'right_paren'};
260             }
261 22         38 $leading_const->($coeff);
262             }
263              
264             ### final xpow: $xpow
265 29 100       64 if ($limit != $degree) {
266 2 100       6 if ($last != _EMPTY) {
267 1         3 $ret .= $config{'plus'};
268             }
269 2         4 $xpow++;
270 2         5 $show_xpow->();
271             }
272              
273             } else {
274             ### descending
275              
276 104         267 my $coeff = $poly->coeff($degree);
277             ### highest coeff: "$coeff"
278 104         790 my $i = $degree;
279              
280             {
281 104         106 my ($j, $second);
  104         104  
282 104 50 100     489 if ($config{'fold_sign'} && $config{'fold_sign_swap_end'}
      66        
      66        
      33        
283             && $coeff < $zero
284             && (($j,$second) = _second_highest_coeff($poly,$config{'fold_zero'}))
285             && $second > $zero) {
286 2         5 $leading_const->($second);
287 2         4 $plus_coeff->($coeff);
288 2         2 $last = _FACTOR;
289 2         2 $xpow = $degree - $j;
290 2         5 $times_xpow->();
291 2         3 $i = $j - 1;
292 2         3 $last = _SUM;
293             ### fold_sign_swap_end gives
294             ### $ret
295             ### $i
296             }
297             }
298              
299             # normal start from high coeff, ie. not the swap bit
300 104 100       194 if ($i == $degree) {
301 102         186 $leading_factor->($coeff);
302 102         110 $i--;
303             }
304 104         215 for ( ; $i >= 0; $i--) {
305             ### $i
306 195         192 $xpow++;
307 195         503 $coeff = $poly->coeff($i);
308 195 100 100     1903 if ($config{'fold_zero'} && $coeff == $zero) {
309 96         446 next;
310             }
311 99         161 $times_xpow->();
312 99         167 $plus_coeff->($coeff);
313             }
314 104         154 $times_xpow->();
315             }
316              
317             ### prefix: $config{'prefix'}
318             ### $pre
319             ### $ret
320             ### $post
321             ### suffix: $config{'suffix'}
322 133         2774 return $config{'prefix'} . $pre . $ret . $post . $config{'suffix'};
323             }
324              
325             sub _second_highest_coeff {
326 4     4   28 my ($poly, $fold_zero) = @_;
327 4         12 my $j = $poly->degree;
328             ### assert: $j >= 0
329              
330 4         14 for (;;) {
331 10 50       46 if (--$j < 0) {
332 0         0 return; # not found
333             }
334 10         22 my $coeff = $poly->coeff($j);
335 10 100 66     87 unless ($fold_zero && $coeff == $poly->coeff_zero) {
336 4         47 return ($j, $coeff); # found
337             }
338             }
339             }
340              
341             1;
342             __END__