This is an automated email from the git hooks/post-receive script.
ppm-guest pushed a commit to annotated tag v0.13
in repository libmath-prime-util-perl.
commit 050e1858073a16c81d4a3d05ec3ef9e3709909f9
Author: Dana Jacobsen <d...@acm.org>
Date: Fri Oct 19 01:54:48 2012 -0600
More primes.pl changes, and script test does multiple filters
---
bin/primes.pl | 171 ++++++++++++++++++++++++-----------------
examples/test-primes-script.pl | 44 ++++++++---
2 files changed, 135 insertions(+), 80 deletions(-)
diff --git a/bin/primes.pl b/bin/primes.pl
index 80bfb7d..5d7a427 100755
--- a/bin/primes.pl
+++ b/bin/primes.pl
@@ -65,7 +65,6 @@ GetOptions(\%opts,
die_usage() if exists $opts{'help'};
Math::Prime::Util::prime_set_config(gmp=>0) if exists $opts{'nompugmp'};
-
# Get the start and end values. Verify they're positive integers.
die_usage() unless @ARGV == 2;
my ($start, $end) = @ARGV;
@@ -81,13 +80,58 @@ if ( ($start >= ~0 && $start ne ~0) || ($end >= ~0 && $end
ne ~0) ) {
$end = Math::BigInt->new($end);
}
+# Calculate the mod 210 pre-test. This helps with the individual filters,
+# but the real benefit is that it convolves the pretests, which can speed
+# up even more.
+my ($min_pass, %mod_pass) = find_mod210_restriction();
+# Find out if they've filtered so much nothing passes (e.g. cousin quad)
+if (scalar keys %mod_pass == 0) {
+ $end = $min_pass if $end > $min_pass;
+}
+
+if ($start > $end) {
+ # Do nothing
+} elsif (exists $opts{'lucas'} ||
+ exists $opts{'fibonacci'} ||
+ exists $opts{'euclid'} ||
+ exists $opts{'mersenne'}
+ ) {
+ my @p = gen_and_filter($start, $end);
+ print join("\n", @p), "\n" if scalar @p > 0;
+} else {
+ my @p;
+ while ($start <= $end) {
+
+ # Adjust segment sizes for some cases
+ $segment_size = 10000 if $start > ~0; # small if doing bigints
+ if (exists $opts{'pillai'}) {
+ $segment_size = ($start < 10000) ? 100 : 1000; # very small for Pillai
+ }
+ if (exists $opts{'palindromic'}) {
+ $segment_size = 10**length($start) - $start - 1; # all n-digit numbers
+ }
+
+ my $seg_start = $start;
+ my $seg_end = $start + $segment_size;
+ $seg_end = $end if $end < $seg_end;
+ $start = $seg_end+1;
+
+ @p = gen_and_filter($seg_start, $seg_end);
+
+ # print this segment
+ print join("\n", @p), "\n" if scalar @p > 0;
+ }
+}
+
+
# Fibonacci numbers
{
- my @fibs = (Math::BigInt->new(0), Math::BigInt->new(1));
+ my @fibs;
sub fib {
my $n = shift;
return $n if $n < 2;
if (!defined $fibs[$n]) {
+ @fibs = (Math::BigInt->new(0), Math::BigInt->new(1)) if scalar @fibs ==
0;
my ($nm2, $nm1) = ($fibs[-2],$fibs[-1]);
for (scalar @fibs .. $n) {
($nm2, $nm1) = ($nm1, $nm2 + $nm1);
@@ -265,44 +309,46 @@ sub gen_and_filter {
}
}
+ if (exists $opts{'twin'} && !defined $gen) {
+ @p = @{primes($start, $end)};
+ push @p, is_prime($p[-1]+2) ? $p[-1]+2 : 0;
+ my @twin;
+ my $prime = shift @p;
+ foreach my $next (@p) {
+ push @twin, $prime if $prime+2 == $next;
+ $prime = $next;
+ }
+ @p = @twin;
+ $gen = 'twin';
+ }
+
if (!defined $gen) {
@p = @{primes($start, $end)};
$gen = 'primes';
}
- if (exists $opts{'twin'}) {
- if ($gen ne 'primes') {
- @p = grep { is_prime( $_+2 ); } @p;
- } elsif (scalar @p > 0) {
- # All primes in the range are here, so just look in the array.
- push @p, is_prime($p[-1]+2) ? $p[-1]+2 : 0;
- my @twin;
- my $prime = shift @p;
- foreach my $next (@p) {
- push @twin, $prime if $prime+2 == $next;
- $prime = $next;
- }
- @p = @twin;
- }
+ # Apply the mod 210 pretest
+ if ($min_pass > 0) {
+ @p = grep { $_ <= $min_pass || exists $mod_pass{$_ % 210} } @p;
}
- if (exists $opts{'triplet'}) { # could be optimized like twin
+ if (exists $opts{'twin'} && $gen ne 'twin') {
+ @p = grep { is_prime( $_+2 ); } @p;
+ }
+
+ if (exists $opts{'triplet'}) {
@p = grep { is_prime($_+6) && (is_prime($_+2) || is_prime($_+4)); } @p;
}
- if (exists $opts{'quadruplet'}) { # could be optimized like twin
- @p = grep { is_prime($_+2) && is_prime($_+6) && is_prime($_+8); }
- grep { $_ <= 5 || ($_ % 30) == 11; }
- @p;
+ if (exists $opts{'quadruplet'}) {
+ @p = grep { is_prime($_+2) && is_prime($_+6) && is_prime($_+8); } @p;
}
- if (exists $opts{'cousin'}) { # could be optimized like twin
- @p = grep { is_prime($_+4); }
- grep { ($_ <= 3) || ($_ % 6) == 1; }
- @p;
+ if (exists $opts{'cousin'}) {
+ @p = grep { is_prime($_+4); } @p;
}
- if (exists $opts{'sexy'}) { # could be optimized like twin
+ if (exists $opts{'sexy'}) {
@p = grep { is_prime($_+6); } @p;
}
@@ -312,24 +358,14 @@ sub gen_and_filter {
@p;
}
if (exists $opts{'sophie'}) {
- my %mod210;
- undef @mod210{11,23,29,41,53,71,83,89,113,131,149,173,179,191,209};
- @p = grep { is_prime( 2*$_+1 ); }
- grep { $_ <= 5 || exists $mod210{$_ % 210} }
- @p;
+ @p = grep { is_prime( 2*$_+1 ); } @p;
}
if (exists $opts{'cuban1'}) {
- my %mod210;
- undef @mod210{1,19,37,61,79,121,127,169,187};
- @p = grep { my $n = sqrt((4*$_-1)/3); $n == int($n); }
- #grep { ($_%3) == 1 }
- grep { $_ <= 7 || exists $mod210{$_ % 210} }
- @p;
+ #@p = grep { my $n = sqrt((4*$_-1)/3); $n == int($n); } @p;
+ @p = grep { my $n = sqrt((4*$_-1)/3); 4*$_ == int($n)*int($n)*3+1; } @p;
}
if (exists $opts{'cuban2'}) {
- @p = grep { my $n = sqrt(($_-1)/3); $n == int($n); }
- grep { ($_%3) == 1 }
- @p;
+ @p = grep { my $n = sqrt(($_-1)/3); $_ == int($n)*int($n)*3+1; } @p;
}
if (exists $opts{'pnm1'}) {
@p = grep { is_prime( primorial(Math::BigInt->new($_))-1 ) } @p;
@@ -346,40 +382,37 @@ sub gen_and_filter {
@p;
}
-if (exists $opts{'lucas'} ||
- exists $opts{'fibonacci'} ||
- exists $opts{'euclid'} ||
- exists $opts{'mersenne'}) {
- my @p = gen_and_filter($start, $end);
- print join("\n", @p), "\n" if scalar @p > 0;
-} else {
- my @p;
- while ($start <= $end) {
-
- # Adjust segment sizes for some cases
- $segment_size = 10000 if $start > ~0; # small if doing bigints
- if (exists $opts{'pillai'}) {
- $segment_size = ($start < 10000) ? 100 : 1000; # very small for Pillai
- }
- if (exists $opts{'palindromic'}) {
- $segment_size = 10**length($start) - $start - 1; # all n-digit numbers
+sub find_mod210_restriction {
+ my %mods_left;
+ undef @mods_left{ grep { ($_%2) && ($_%3) && ($_%5) && ($_%7) } (0..209) };
+
+ my %mod210_restrict = (
+ cuban1 => {min=> 7, mod=>[1,19,37,61,79,121,127,169,187]},
+ cuban2 => {min=> 2, mod=>[1,13,43,109,139,151,169,181,193]},
+ twin => {min=> 5,
mod=>[11,17,29,41,59,71,101,107,137,149,167,179,191,197,209]},
+ triplet => {min=> 7,
mod=>[11,13,17,37,41,67,97,101,103,107,137,163,167,187,191,193]},
+ quadruplet => {min=> 5, mod=>[11,101,191]},
+ cousin => {min=> 7,
mod=>[13,19,37,43,67,79,97,103,109,127,139,163,169,187,193]},
+ sexy => {min=> 7,
mod=>[11,13,17,23,31,37,41,47,53,61,67,73,83,97,101,103,107,121,131,137,143,151,157,163,167,173,181,187,191,193]},
+ safe => {min=>11,
mod=>[17,23,47,53,59,83,89,107,137,143,149,167,173,179,209]},
+ sophie => {min=> 5,
mod=>[11,23,29,41,53,71,83,89,113,131,149,173,179,191,209]},
+ # Nothing for good, pillai, palindromic, fib, lucas, mersenne, primorials
+ );
+
+ my $min = 0;
+ while (my($filter,$data) = each %mod210_restrict) {
+ next unless exists $opts{$filter};
+ $min = $data->{min} if $min < $data->{min};
+ my %thismod;
+ undef @thismod{ @{$data->{mod}} };
+ foreach my $m (keys %mods_left) {
+ delete $mods_left{$m} unless exists $thismod{$m};
}
-
- my $seg_start = $start;
- my $seg_end = $start + $segment_size;
- $seg_end = $end if $end < $seg_end;
- $start = $seg_end+1;
-
- @p = gen_and_filter($seg_start, $seg_end);
-
- # print this segment
- print join("\n", @p), "\n" if scalar @p > 0;
}
+ return ($min, %mods_left);
}
-
-
sub die_usage {
die <<EOU;
Usage: $0 [options] START END
diff --git a/examples/test-primes-script.pl b/examples/test-primes-script.pl
index e91ccdb..7f3390f 100755
--- a/examples/test-primes-script.pl
+++ b/examples/test-primes-script.pl
@@ -31,16 +31,27 @@ my @test_data = (
[18239, "Euclid", "--euclid", 0],
);
my %oeis_name = map { $_->[0] => $_->[1] } @test_data;
+my %oeis_number = map { my $n=$_->[2]; $n=~s/^--//; $n => $_->[0] } @test_data;
+
+# Verify additional filters
+my @additional_filters;
+foreach my $name (@ARGV) {
+ $name =~ s/^--//;
+ die "Unknown filter: $name\n" unless defined $oeis_number{$name};
+ push @additional_filters, $name;
+}
my $test_data_hash = read_script_data('script-test-data.bs');
+if (@additional_filters > 0) {
+ print "Additional Filters: ", join(" ", @additional_filters), "\n";
+}
foreach my $test (@test_data) {
my $oeis_no = $test->[0];
- my $test_data = $test_data_hash->{$oeis_no};
- if (!defined $test_data) {
+ if (!defined $test_data_hash->{$oeis_no}) {
die "No test data found for OEIS $oeis_no : $test->[1] primes\n";
}
- test_oeis(@$test, $test_data);
+ test_oeis(@$test, $test_data_hash);
}
@@ -49,6 +60,9 @@ foreach my $test (@test_data) {
sub read_script_data {
my ($filename) = @_;
+ die "Can't find test file: $filename\nRun make-script-test-data.pl\n"
+ unless -r $filename;
+
my $stream = Data::BitStream::XS->new( file => $filename, mode => 'ro' );
my %hash;
@@ -89,20 +103,28 @@ sub read_script_data {
}
sub test_oeis {
- my($oeis_no, $name, $script_arg, $restrict, $ref_data) = @_;
+ my($oeis_no, $name, $script_arg, $restrict, $test_data_hash) = @_;
+
+ my @ref = @{ $test_data_hash->{$oeis_no} };
+ my $end = $ref[-1];
+
+ foreach my $filter_name (@additional_filters) {
+ my $filter_no = $oeis_number{$filter_name};
+ my %filter_data;
+ undef @filter_data{ @{$test_data_hash->{$filter_no}} };
+ my $filter_end = $test_data_hash->{$filter_no}->[-1];
+ @ref = grep { exists $filter_data{$_} } @ref;
+ $script_arg .= " --$filter_name";
+ $end = $filter_end if $end > $filter_end; # bring endpoint down
+ }
- my @ref = @$ref_data;
printf "%12s primes (OEIS A%06d): generating..", $name, $oeis_no;
- #print "\n";
- #print "reference data:\n";
- #print " $_\n" for @ref;
- #print "primes.pl $script_arg 1 $ref[-1]\n";
my $start = [gettimeofday];
- my @scr = split /\s+/, qx+$FindBin::Bin/../bin/primes.pl $script_arg 1
$ref[-1]+;
+ my @scr = split /\s+/, qx+$FindBin::Bin/../bin/primes.pl $script_arg 1 $end+;
{
no bigint;
- my $num_generated = scalar @scr;
+ my $num_generated = scalar @scr || 0.1;
my $seconds = tv_interval($start);
my $msperprime = ($seconds * 1000.0) / $num_generated;
printf " %7d. %7.2f ms/prime\n", $num_generated, $msperprime;
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/libmath-prime-util-perl.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
