File Coverage

bin/factor
Criterion Covered Total %
statement 59 67 88.0
branch 25 34 73.5
condition 2 5 40.0
subroutine 4 4 100.0
pod n/a
total 90 110 81.8


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             =begin metadata
4              
5             Name: factor
6             Description: factor a number
7             Author: Jonathan Feinberg, jdf@pobox.com
8             Author: Benjamin Tilly, ben.tilly@alumni.dartmouth.org
9             Contributor: brian d foy, bdfoy@cpan.org
10             Contributor: Dana Jacobson, danaj@cpan.org
11             License: perl
12              
13             =end metadata
14              
15             =cut
16              
17              
18             package PerlPowerTools::factor;
19              
20 1     1   1763 use strict;
  1         2  
  1         895  
21             $|++;
22             my @primes = (2, 3, 5, 7, 11); # None have been tested
23             my @next_primes = (); # Avoid redoing work
24              
25              
26             my $VERSION = '1.002';
27              
28             END {
29             close STDOUT || die "$0: can't close stdout: $!\n";
30             $? = 1 if $? == 255; # from die
31             }
32              
33             __PACKAGE__->run( \*STDOUT, @ARGV ) unless caller(); # modulino
34              
35             sub run {
36 1014     1014   665212 my( $self, $fh, @numbers ) = @_;
37 1014 50       2305 $fh = *STDOUT unless defined $fh;
38              
39 1014         2318 my $old = select $fh;
40              
41 1014 50       1974 if( @numbers ) {
42 1014         1440 foreach ( @numbers ) { factor($_) }
  1015         1473  
43             }
44             else {
45 0         0 while (<>) {
46 0         0 chomp;
47 0 0       0 if (/^\s*(\S+)/) {
48 0         0 factor($1);
49             }
50             }
51             }
52              
53 1014         1933 select $old;
54              
55 1014         2063 exit 0;
56             }
57              
58             sub factor {
59 1015     1015   1358 my $n = shift;
60 1015 50 33     7557 unless ($n =~ /^\+?\d{1,10}$/ && $n <= 2**32 - 1) {
61 0         0 warn "$0: `$_' is not a valid positive integer\n";
62 0         0 return;
63             }
64 1015 50       1860 exit 0 if $n == 0;
65 1015         2335 print "$n:";
66 1015 50       1547 if ($n == 1) { print "1\n"; return }
  0         0  
  0         0  
67             # Start with existing list
68 1015         1787 foreach my $prime (@primes) {
69 16921         23879 while ($n % $prime == 0) {
70 38         57 print " $prime";
71 38         82 $n /= $prime;
72             }
73             }
74 1015         1863 while ($primes[-1] * $primes[-1] < $n) {
75 869         3686 &more_primes(int($n**0.5)+1); # the doubles might come in slightly under, so add 1
76 869 100       1691 last unless scalar @next_primes; # Avoid the chance of an endless loop
77 14         18 foreach my $prime (@next_primes) {
78 18         36 while ($n % $prime == 0) {
79 1         3 print " $prime";
80 1         2 $n /= $prime;
81             }
82 18 100       37 last if $n < $prime * $prime;
83             }
84 14         32 push @primes, @next_primes;
85             }
86 1015 100       1528 if ($n > 1) { print " $n" }
  995         1893  
87 1015         1598 print "\n";
88             }
89              
90             sub more_primes {
91             # This adds to the list of primes until it reaches $max
92             # or the square of the largest current prime (assumed odd)
93 869   50 869   1509 my $max = shift||32000;
94 869         904 my $square = $primes[-1] * $primes[-1];
95 869 50       1226 $max = $square if $square < $max; # Determine what to find primes to
96 869         1245 my $base = $primes[-1] + 2; # First possible prime
97 869 50       1441 $base++ unless $base % 2; # Make the base odd
98 869 100       1358 $max-- if $max %2; # Make the max odd
99 869         1195 $max = ($max - $base)/2; # Make $max into a count of odds
100 869 100       1535 return @next_primes = () if $max < 0; # Sanity check
101 485         908 my @more = map {0} 0..$max; # Initialize array of 0's for the
  690         1292  
102             # odd numbers in our range
103 485         629 shift @primes; # Remove 2
104 485         606 foreach my $p (@primes) {
105 1850         1630 my $start;
106 1850 100       2300 if ($base < $p * $p) {
107 486         610 $start = ($p * $p - $base)/2; # Start at the square
108 486 100       726 if ($max < $start) { # Rest of primes don't matter!
109 485         714 last;
110             }
111             }
112             else { # Start at first odd it divides
113 1364         1310 $start = $base % $p; # Find remainder
114 1364 100       1782 $start = $p - $start if $start; # Distance to first thing it divides
115 1364 100       1820 $start += $p if $start %2; # Distance to first odd it divides
116 1364         1295 $start = $start/2; # Reindex for counting over odd!
117             }
118 1365         2094 for (my $i = $start; $i <= $max; $i += $p) {
119 830         1634 $more[$i] = 1;
120             }
121             }
122 485         685 unshift @primes, 2; # Replace 2
123             # Read off list of primes
124 485         644 @next_primes = map {$_ + $_ + $base} grep {$more[$_] == 0} 0..$max;
  18         36  
  690         1719  
125             }
126              
127              
128             __END__