[libmath-prime-util-perl] 04/07: threading and PP changes
Partha P. Mukherjee
ppm-guest at moszumanska.debian.org
Thu May 21 18:44:42 UTC 2015
This is an automated email from the git hooks/post-receive script.
ppm-guest pushed a commit to annotated tag v0.09
in repository libmath-prime-util-perl.
commit bfcdbea1da3e04f99ccf5ee4e42c5f58b3bb434d
Author: Dana Jacobsen <dana at acm.org>
Date: Mon Jun 25 02:34:56 2012 -0600
threading and PP changes
---
Changes | 11 +++-
README | 2 +-
lib/Math/Prime/Util.pm | 22 ++++----
lib/Math/Prime/Util/PP.pm | 126 +++++++++++++++++++++++++---------------------
t/31-threading.t | 67 +++++++++++++++++++++---
util.c | 32 ++++++------
6 files changed, 167 insertions(+), 93 deletions(-)
diff --git a/Changes b/Changes
index 0a6c18f..4d444fa 100644
--- a/Changes
+++ b/Changes
@@ -1,7 +1,14 @@
Revision history for Perl extension Math::Prime::Util.
-0.09 23 June 2012
- - Pure Perl code. Passes all tests, but 1 to 13000x slower.
+0.09 25 June 2012
+ - Pure Perl code. Passes all tests, but 1 to 120x slower. Test suite
+ as a whole is 38x slower.
+ - Modifications to threading test:
+ - some machines were failing because they use non-TS rand. Fix by
+ making our own rand.
+ - Win32 was failing because of unique threading issues. It barfs
+ if you free memory on a different thread than allocated it.
+ - is_prime could return 1 in some cases. Fixed.
0.08 22 June 2012
- Added thread safety and tested good concurrency.
diff --git a/README b/README
index 80a23bf..9b6ebf1 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Math::Prime::Util version 0.08
+Math::Prime::Util version 0.09
A set of utilities related to prime numbers. These include multiple sieving
methods, is_prime, prime_count, nth_prime, approximations and bounds for
diff --git a/lib/Math/Prime/Util.pm b/lib/Math/Prime/Util.pm
index 6795b23..f680a79 100644
--- a/lib/Math/Prime/Util.pm
+++ b/lib/Math/Prime/Util.pm
@@ -5,7 +5,7 @@ use Carp qw/croak confess carp/;
BEGIN {
$Math::Prime::Util::AUTHORITY = 'cpan:DANAJ';
- $Math::Prime::Util::VERSION = '0.08';
+ $Math::Prime::Util::VERSION = '0.09';
}
# parent is cleaner, and in the Perl 5.10.1 / 5.12.0 core, but not earlier.
@@ -265,7 +265,7 @@ Math::Prime::Util - Utilities related to prime numbers, including fast sieves an
=head1 VERSION
-Version 0.08
+Version 0.09
=head1 SYNOPSIS
@@ -818,14 +818,16 @@ Pi(10^10) = 455,052,511.
Perl modules, counting the primes to C<800_000_000> (800 million), in seconds:
- Time (s) Module Version
- -------- -------------------------- ------
- 0.4 Math::Prime::Util 0.02
- 0.9 Math::Prime::Util 0.01
- 2.9 Math::Prime::FastSieve 0.12
- 11.7 Math::Prime::XS 0.29
- 15.0 Bit::Vector 7.2
- [hours] Math::Primality 0.04
+ Time (s) Module Version Notes
+ --------- -------------------------- ------- -----------
+ 0.36 Math::Prime::Util 0.09 segmented mod-30 sieve
+ 0.9 Math::Prime::Util 0.01 mod-30 sieve
+ 2.9 Math::Prime::FastSieve 0.12 decent odd-number sieve
+ 11.7 Math::Prime::XS 0.29 "" but needs a count API
+ 15.0 Bit::Vector 7.2
+ 59.1 Math::Prime::Util::PP 0.09 Perl
+ 548.1 RosettaCode sieve 2012-06 simplistic Perl
+ [hours] Math::Primality 0.04 Perl + GMP
diff --git a/lib/Math/Prime/Util/PP.pm b/lib/Math/Prime/Util/PP.pm
index 25d767a..e9c40d8 100644
--- a/lib/Math/Prime/Util/PP.pm
+++ b/lib/Math/Prime/Util/PP.pm
@@ -5,7 +5,7 @@ use Carp qw/carp croak confess/;
BEGIN {
$Math::Prime::Util::PP::AUTHORITY = 'cpan:DANAJ';
- $Math::Prime::Util::PP::VERSION = '0.08';
+ $Math::Prime::Util::PP::VERSION = '0.09';
}
# The Pure Perl versions of all the Math::Prime::Util routines.
@@ -101,30 +101,36 @@ sub is_prime {
return _is_prime7($n);
}
-sub _sieve_erat {
- my($end) = @_;
- my $last = int(($end+1)/2);
+# Possible sieve storage:
+# 1) vec with mod-30 wheel: 8 bits / 30
+# 2) vec with mod-2 wheel : 15 bits / 30
+# 3) str with mod-30 wheel: 8 bytes / 30
+# 4) str with mod-2 wheel : 15 bytes / 30
+#
+# It looks like using vecs is about 2x slower than strs, and the strings also
+# let us do some fast operations on the results. E.g.
+# Count all primes:
+# $count += $$sieveref =~ tr/0//;
+# Loop over primes:
+# foreach my $s (split("0", $$sieveref, -1)) {
+# $n += 2 + 2 * length($s);
+# .. do something with the prime $n
+# }
+#
+# We're using method 4, though sadly it is memory intensive.
+#
+# Even so, it is a lot less memory than making an array entry for each number,
+# and the performance is almost 10x faster than a naive array sieve.
- my $sieve = '';
- my $n = 3;
- while ( ($n*$n) <= $end ) {
- my $s = $n*$n;
- while ($s <= $end) {
- vec($sieve, $s >> 1, 1) = 1;
- $s += 2*$n;
- }
- do { $n += 2 } while vec($sieve, $n >> 1, 1) != 0;
- }
- # Mark 1 as composite
- vec($sieve, 0, 1) = 1;
- $sieve;
-}
-# Uses 8x more memory, but almost 2x faster
sub _sieve_erat_string {
my($end) = @_;
- my $sieve = "1" . "0" x ($end>>1);
- my $n = 3;
+ # Prefill with 3 and 5 already marked.
+ my $whole = int( ($end>>1) / 15);
+ my $sieve = "100010010010110" . "011010010010110" x $whole;
+ # Make exactly the number of entries requested, never more.
+ substr($sieve, ($end>>1)+1) = '';
+ my $n = 7;
while ( ($n*$n) <= $end ) {
my $s = $n*$n;
my $filter_s = $s >> 1;
@@ -137,6 +143,27 @@ sub _sieve_erat_string {
}
\$sieve;
}
+
+# TODO: this should be plugged into precalc, memfree, etc. just like the C code
+{
+ my $primary_size_limit = 15000;
+ my $primary_sieve_size = 0;
+ my $primary_sieve_ref;
+ sub _sieve_erat {
+ my($end) = @_;
+
+ return _sieve_erat_string($end) if $end > $primary_size_limit;
+
+ if ($primary_sieve_size == 0) {
+ $primary_sieve_size = $primary_size_limit;
+ $primary_sieve_ref = _sieve_erat_string($primary_sieve_size);
+ }
+ my $sieve = substr($$primary_sieve_ref, 0, ($end+1)>>1);
+ \$sieve;
+ }
+}
+
+
sub _sieve_segment {
my($beg,$end) = @_;
croak "Internal error: segment beg is even" if ($beg % 2) == 0;
@@ -145,14 +172,25 @@ sub _sieve_segment {
croak "Internal error: segment beg should be >= 3" if $beg < 3;
my $range = int( ($end - $beg) / 2 ) + 1;
- # Replicate the string "010" and we've just marked 3's.
- # Replicate "011010010010110" and we've marked 3's and 5's.
- my $sieve = "0" x $range;
+ # Prefill with 3 and 5 already marked, and offset to the segment start.
+ my $whole = int( ($range+14) / 15);
+ my $startp = ($beg % 30) >> 1;
+ my $sieve = substr("011010010010110", $startp) . "011010010010110" x $whole;
+ # Set 3 and 5 to prime if we're sieving them.
+ substr($sieve,0,2) = "00" if $beg == 3;
+ substr($sieve,0,1) = "0" if $beg == 5;
+ # Get rid of any extra we added.
+ substr($sieve, $range) = '';
+
+ # If the end value is below 7^2, then the pre-sieve is all we needed.
+ return \$sieve if $end < 49;
+
my $limit = int(sqrt($end)) + 1;
- # We'd like to go through just the primes, but we'll keep things simple by
- # just skipping multiples of 2/3/5/7/11/13/17/19.
- my $p = 3;
- while ($p <= $limit) {
+ # For large value of end, it's a huge win to just walk primes.
+ my $primesieveref = _sieve_erat($limit);
+ my $p = 7-2;
+ foreach my $s (split("0", substr($$primesieveref, 3), -1)) {
+ $p += 2 + 2 * length($s);
my $p2 = $p*$p;
last if $p2 > $end;
if ($p2 < $beg) {
@@ -172,16 +210,6 @@ sub _sieve_segment {
$filter_p2 += $p;
}
}
- $p += 2;
- # Skip obvious composites.
- if ($p <= 19) {
- $p += 2 if $p == 9;
- $p += 2 if $p == 15;
- } else {
- while ( (($p % 3) == 0) || (($p % 5) == 0) || (($p % 7) == 0) || (($p % 11) == 0) || (($p % 13) == 0) || (($p % 17) == 0) || (($p % 19) == 0) ) {
- $p+= 2;
- }
- }
}
\$sieve;
}
@@ -209,23 +237,8 @@ sub primes {
$high-- if ($high % 2) == 0;
return $sref if $low > $high;
- #if ($low == 7) {
- # my $sieveref = _sieve_erat_string($high);
- # my $n = 7;
- # while ($n <= $high) {
- # push @$sref, $n if !substr($$sieveref,$n>>1,1);
- # $n += 2;
- # }
- #} else {
- # my $sieveref = _sieve_segment($low,$high);
- # my $n = $low;
- # while ($n <= $high) {
- # push @$sref, $n if !substr($$sieveref,($n-$low)>>1,1);
- # $n += 2;
- # }
- #}
if ($low == 7) {
- my $sieveref = _sieve_erat_string($high);
+ my $sieveref = _sieve_erat($high);
my $n = $low - 2;
foreach my $s (split("0", substr($$sieveref, 3), -1)) {
$n += 2 + 2 * length($s);
@@ -312,9 +325,8 @@ sub prime_count {
my $sieveref;
if ($low == 3) {
- $sieveref = _sieve_erat_string($high);
+ $sieveref = _sieve_erat($high);
} else {
- return 0 if $low > $high;
$sieveref = _sieve_segment($low,$high);
}
@@ -1048,7 +1060,7 @@ Math::Prime::Util::PP - Pure Perl version of Math::Prime::Util
=head1 VERSION
-Version 0.08
+Version 0.09
=head1 SYNOPSIS
diff --git a/t/31-threading.t b/t/31-threading.t
index ec1704f..cb59571 100644
--- a/t/31-threading.t
+++ b/t/31-threading.t
@@ -2,6 +2,7 @@
use strict;
use warnings;
+my $is_win32 = 0;
use Config;
BEGIN {
if (! $Config{useithreads} || $] < 5.008) {
@@ -13,23 +14,60 @@ BEGIN {
print "1..0 # Skip threads.pm not installed\n";
exit 0;
}
+ if ($Config{osname} eq 'MSWin32') {
+ $is_win32 = 1;
+ #print "1..0 # Skip this module's threading not implemented on Win32\n";
+ #exit 0;
+ }
}
use Test::More 'tests' => 9;
use Math::Prime::Util ":all";
+
+# threads are memory hogs, so we want few of them. But for testing purposes,
+# we want a lot of them. 4-8 perhaps.
my $numthreads = 8;
-srand(50);
-my @randn;
-push @randn, rand(100000) for (0..377);
+# Random numbers, pregenerated
+my @randn = (
+ qw/71094 1864 14650 58418 46196 45215 70355 80402 70420 33457 73424 45744
+ 22229 61529 82574 61578 26369 76750 15724 61272 52128 77252 2207 3579
+ 69734 14488 20846 46906 6992 43938 34945 51978 11336 58462 11973 75248
+ 39165 8147 62890 63565 39279 47830 43617 40299 65372 37479 884 27007
+ 24978 55716 38115 71502 30134 40903 71231 40095 9054 54133 13876 55660
+ 44544 1880 39217 36609 38711 49576 55029 21831 75022 69128 2311 16321
+ 1400 9659 6010 8206 78113 76539 17430 69393 26519 50162 49317 20231
+ 11019 28515 73527 50147 33512 28347 19122 66580 14286 81842 38344 10886
+ 52253 57834 37446 49360 24401 45815 54811 1703 38180 22473 17946 58833
+ 29700 55366 35155 31902 28299 34139 51961 75210 9126 30331 54658 50208
+ 13936 57086 27118 75817 31571 76715 53441 31118 22091 47356 67284 37756
+ 67826 819 78844 64174 53566 28410 40455 76690 69141 2001 1251 39140
+ 2328 49159 14379 73801 30195 19745 72355 51038 76557 63516 54486 45951
+ 65586 61730 6310 73490 71132 25970 51034 27856 11490 25817 24283 52759
+ 68248 9246 52896 72365 31983 74001 16616 63960 70718 43518 27054 6397
+ 1247 64241 27517 2927 3557 76192 36376 21334 1395 20926 36088 65519
+ 2650 9739 23758 74720 34458 41096 51926 45932 14850 38181 60833 53481
+ 8086 43319 11891 22674 22916 72918 3650 35246 39543 25544 35578 67023
+ 50752 29653 76351 64909 9425 27547 10108 13399 69540 3833 12748 6386
+ 76511 28041 31586 50034 8828 17845 44376 74301 39762 40216 5092 16261
+ 7434 29908 18671 7189 18373 31608 67155 19129 20586 6713 73424 20568
+ 64299 71411 53762 20070 56014 3560 9129 50993 44983 15434 5035 77815
+ 22836 9786 24808 50756 15298 48358 36466 4308 195 69058 55813 18840
+ 23284 41448 37349 59268 36894 79674 31694 73975 71738 18344 26328 5264
+ 79976 26714 27187 65237 18881 74975 28505 16271 51390 22598 65689 65512
+ 20357 68743 72422 69481 26714 6824 30012/);
thread_test(
sub { my $sum = 0; $sum += prime_count($_) for (@randn); return $sum;},
$numthreads, "sum prime_count");
-thread_test(
- sub { my $sum = 0; for (@randn) {$sum += prime_count($_); prime_memfree; } return $sum;},
- $numthreads, "sum prime_count with overlapping memfree calls");
+SKIP: {
+ skip "Win32 needs precalc, skipping alloc/free stress test", 1 if $is_win32;
+
+ thread_test(
+ sub { my $sum = 0; for (@randn) {$sum += prime_count($_); prime_memfree; } return $sum;},
+ $numthreads, "sum prime_count with overlapping memfree calls");
+}
thread_test(
sub { my $sum = 0; for my $d (@randn) { for my $f (factor($d)) { $sum += $f; } } return $sum; },
@@ -51,8 +89,19 @@ thread_test(
sub { my $sum = 0; $sum += is_prime($_) for (@randn); return $sum;},
$numthreads, "is_prime");
+# Override rand because some systems don't use thread-safe rand, which will
+# make this test go beserk (it doesn't make *sense* without TS rand).
+# This should provide a semi-random result that depends on the seed given.
+# rand should return a number in the range [0,1) --- 0 is ok, 1 is not. Since
+# this is all in Perl, it all gets duped with the interpreter so is TS.
+{
+ my $seed = 1;
+ sub mysrand { $seed = $_[0]; }
+ sub rand { $seed = (1103515245*$seed + 12345) & 0xFFFF_FFFF; $seed/(0xFFFF_FFFF+1); }
+}
+
thread_test(
- sub { my $sum = 0; for (@randn) { srand($_); $sum += random_ndigit_prime(6); } return $sum;},
+ sub { my $sum = 0; for (@randn) { mysrand($_); $sum += random_ndigit_prime(6); } return $sum;},
$numthreads, "random 7-digit prime");
thread_test(
@@ -64,6 +113,10 @@ sub thread_test {
my $nthreads = shift;
my $text = shift;
+ if ($is_win32) {
+ prime_precalc(1_200_000); # enough for all these tests
+ }
+
my @threads;
# Fire off all our threads
push @threads, threads->create($tsub) for (1..$nthreads);
diff --git a/util.c b/util.c
index d3d040a..4cff197 100644
--- a/util.c
+++ b/util.c
@@ -38,14 +38,14 @@ static int _is_trial_prime7(UV x)
UV q, i;
i = 7;
while (1) { /* trial division, skipping multiples of 2/3/5 */
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 4;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 2;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 4;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 2;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 4;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 6;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 2;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 6;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 4;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 2;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 4;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 2;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 4;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 6;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 2;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 6;
}
return 2;
}
@@ -60,14 +60,14 @@ static int _is_prime7(UV x)
i = 7;
while (1) { /* trial division, skipping multiples of 2/3/5 */
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 4;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 2;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 4;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 2;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 4;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 6;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 2;
- q = x/i; if (q<i) return 1; if (x==(q*i)) return 0; i += 6;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 4;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 2;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 4;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 2;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 4;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 6;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 2;
+ q = x/i; if (q<i) break; if (x==(q*i)) return 0; i += 6;
}
return 2;
}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmath-prime-util-perl.git
More information about the Pkg-perl-cvs-commits
mailing list