File Coverage

blib/lib/Math/NumSeq/DeletablePrimes.pm
Criterion Covered Total %
statement 69 69 100.0
branch 19 20 95.0
condition 6 6 100.0
subroutine 16 16 100.0
pod 4 4 100.0
total 114 115 99.1


line stmt bran cond sub pod time code
1             # Copyright 2012, 2013, 2014 Kevin Ryde
2              
3             # This file is part of Math-NumSeq.
4             #
5             # Math-NumSeq is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Math-NumSeq is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Math-NumSeq. If not, see .
17              
18              
19             # http://mathworld.wolfram.com/DeletablePrime.html
20             #
21              
22              
23             package Math::NumSeq::DeletablePrimes;
24 2     2   7048 use 5.004;
  2         4  
25 2     2   7 use strict;
  2         2  
  2         48  
26 2     2   349 use Math::Prime::XS 0.23 'is_prime'; # version 0.23 fix for 1928099
  2         9582  
  2         107  
27              
28 2     2   8 use vars '$VERSION', '@ISA';
  2         2  
  2         94  
29             $VERSION = 72;
30              
31 2     2   357 use Math::NumSeq;
  2         4  
  2         42  
32 2     2   527 use Math::NumSeq::Primes;
  2         3  
  2         90  
33             @ISA = ('Math::NumSeq');
34             *_is_infinite = \&Math::NumSeq::_is_infinite;
35              
36             # uncomment this to run the ### lines
37             #use Smart::Comments;
38              
39              
40             # use constant name => Math::NumSeq::__('Deletable Primes');
41 2     2   8 use constant description => Math::NumSeq::__('Deletable primes, being primes where deleting a digit gives another prime from which in turn a digit can be deleted, etc.');
  2         15  
  2         7  
42 2     2   7 use constant i_start => 1;
  2         2  
  2         64  
43 2     2   5 use constant characteristic_increasing => 1;
  2         2  
  2         70  
44 2     2   5 use constant values_min => 2;
  2         2  
  2         72  
45              
46             use Math::NumSeq::Base::Digits
47 2     2   318 'parameter_info_array'; # radix parameter
  2         2  
  2         891  
48              
49              
50             #------------------------------------------------------------------------------
51              
52             # cf A080603 deleting a digit leaves a prime
53             # A179336 primes containing at least one prime digit
54             # a superset of the deletables
55             #
56             # http://mathworld.wolfram.com/TruncatablePrime.html
57             # A024770 left truncatable primes
58             # A024785 left truncatable primes, no zero digits
59             # A077390 left-and-right truncatable primes
60             # A137812 left or right truncatable primes
61             # finite 149677 elements to 8939662423123592347173339993799
62             #
63             my @oeis_anum;
64              
65             $oeis_anum[2] = 'A096246';
66             $oeis_anum[10] = 'A080608';
67             # OEIS-Catalogue: A096246 radix=2
68             # OEIS-Catalogue: A080608
69              
70             sub oeis_anum {
71 2     2 1 8 my ($self) = @_;
72 2         3 return $oeis_anum[$self->{'radix'}];
73             }
74              
75             #------------------------------------------------------------------------------
76              
77              
78             sub rewind {
79 8     8 1 740 my ($self) = @_;
80 8         24 $self->{'i'} = $self->i_start;
81 8         28 my $primes_seq = $self->{'primes_seq'} = Math::NumSeq::Primes->new;
82             }
83              
84             sub next {
85 28     28 1 621 my ($self) = @_;
86 28         26 my $primes_seq = $self->{'primes_seq'};
87 28         18 for (;;) {
88 34 50       51 (undef, my $prime) = $primes_seq->next
89             or return;
90 34 100       37 if (_prime_is_deletable($self,$prime)) {
91 28         41 return ($self->{'i'}++, $prime);
92             }
93             }
94             }
95              
96             sub pred {
97 94     94 1 305 my ($self, $value) = @_;
98             ### pred(): $value
99 94   100     129 return ($self->Math::NumSeq::Primes::pred($value)
100             && _prime_is_deletable($self,$value));
101             }
102              
103             sub _prime_is_deletable {
104 67     67   57 my ($self, @pending) = @_;
105              
106 67         62 my $radix = $self->{'radix'};
107 67 100       76 my $target = ($radix == 2 ? 4 : $radix);
108              
109 67         82 while (@pending) {
110             ### pending: join(', ',map{sprintf "%b", $_}@pending)
111              
112 107         90 my $value = pop @pending;
113 107 100       184 next unless is_prime($value);
114 83 100       108 if ($value < $target) {
115             ### reached single digit, or 2,3 for binary ...
116 56         104 return 1;
117             }
118              
119 27         19 my $prev = -1;
120 27 100       40 if ($radix == 10) {
121 19 100       47 foreach my $i (($value =~ /^.(0+)/ ? length($1) : 0)
122             ..
123             length($value)-1) {
124 38         42 my $digit = substr($value,$i,1);
125 38 100       53 next if $digit eq $prev;
126 35         28 $prev = $digit;
127 35         66 push @pending, substr($value,0,$i) . substr($value,$i+1);
128             }
129             } else {
130              
131 8         17 for (my $pow = 1; $value > $pow; $pow *= $radix) {
132 21         17 my $low = $value % $pow;
133 21         21 my $high = int($value/$pow);
134              
135 21         15 my $digit = $high % $radix; # being deleted
136 21 100 100     48 last if $high < $radix && $prev == 0; # don't delete high,0,...
137 20 100       33 next if $digit eq $prev;
138 13         13 $prev = $digit;
139              
140              
141 13         31 push @pending, int($high/$radix) * $pow + $low;
142             }
143             }
144             }
145 11         26 return 0;
146             }
147              
148             1;
149             __END__