Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Perl binarytrees Reini Urban 2012-01-13 #1

Open
wants to merge 6 commits into from

2 participants

This page is out of date. Refresh to see the latest.
View
32 bench/binarytrees/binarytrees.perl
@@ -1,20 +1,20 @@
# The Computer Language Benchmarks Game
# http://shootout.alioth.debian.org/
-#
+#
# contributed by Emanuele Zeppieri
+# modified by Reini Urban
-sub bottomup_tree {
- my ($value, $depth) = @_;
- return $value unless $depth;
- my $value2 = $value * 2; $depth--;
- [ bottomup_tree($value2-1, $depth), bottomup_tree($value2, $depth), $value ]
+use integer;
+
+sub bottomup_tree { # item, depth
+ return $_[0] unless $_[1];
+ my $value = $_[0] * 2;
+ [ $_[0], bottomup_tree($value-1, $_[1]-1), bottomup_tree($value, $_[1]-1) ]
}
-sub check_tree {
- my ($left, $right, $value) = @{ $_[0] };
- $value + (
- ref $left ? check_tree($left) - check_tree($right) : $left - $right
- )
+sub item_check {
+ my ($value, $left, $right) = @{ $_[0] };
+ return !ref($left) ? $value : $value + item_check($left) - item_check($right);
}
my $max_depth = shift @ARGV;
@@ -25,7 +25,7 @@ sub check_tree {
my $stretch_depth = $max_depth + 1;
my $stretch_tree = bottomup_tree(0, $stretch_depth);
print "stretch tree of depth $stretch_depth\t check: ",
- check_tree($stretch_tree), "\n";
+ item_check($stretch_tree), "\n";
undef $stretch_tree;
my $longlived_tree = bottomup_tree(0, $max_depth);
@@ -34,13 +34,13 @@ sub check_tree {
my $iterations = 2 << $max_depth - $depth + $min_depth - 1;
my $check = 0;
- foreach (1..$iterations) {
- $check += check_tree( bottomup_tree(0, $depth) );
- $check += check_tree( bottomup_tree(0, $depth) )
+ foreach my $i (1..$iterations) {
+ $check += item_check( bottomup_tree($i, $depth) );
+ $check += item_check( bottomup_tree(-$i, $depth) )
}
print 2*$iterations, "\t trees of depth $depth\t check: ", $check, "\n"
}
print "long lived tree of depth $max_depth\t check: ",
- check_tree($longlived_tree), "\n"
+ item_check($longlived_tree), "\n"
View
48 bench/binarytrees/binarytrees.perl-1.perl
@@ -0,0 +1,48 @@
+# The Computer Language Benchmarks Game
+# http://shootout.alioth.debian.org/
+#
+# contributed by Emanuele Zeppieri
+# modified by Reini Urban
+
+use integer;
+
+sub bottomup_tree { # item, depth
+ my $item = shift;
+ my $depth = shift;
+ return $item unless $depth;
+ my $value = $item * 2;
+ [ $item, bottomup_tree($value-1, $depth-1), bottomup_tree($value, $depth-1) ]
+}
+
+sub item_check {
+ my ($value, $left, $right) = @{ $_[0] };
+ return !ref($left) ? $value : $value + item_check($left) - item_check($right);
+}
+
+my $max_depth = shift @ARGV;
+my $min_depth = 4;
+
+$max_depth = $min_depth + 2 if $min_depth + 2 > $max_depth;
+
+my $stretch_depth = $max_depth + 1;
+my $stretch_tree = bottomup_tree(0, $stretch_depth);
+print "stretch tree of depth $stretch_depth\t check: ",
+ item_check($stretch_tree), "\n";
+undef $stretch_tree;
+
+my $longlived_tree = bottomup_tree(0, $max_depth);
+
+for ( my $depth = $min_depth; $depth <= $max_depth; $depth += 2 ) {
+ my $iterations = 2 << $max_depth - $depth + $min_depth - 1;
+ my $check = 0;
+
+ foreach my $i (1..$iterations) {
+ $check += item_check( bottomup_tree($i, $depth) );
+ $check += item_check( bottomup_tree(-$i, $depth) )
+ }
+
+ print 2*$iterations, "\t trees of depth $depth\t check: ", $check, "\n"
+}
+
+print "long lived tree of depth $max_depth\t check: ",
+ item_check($longlived_tree), "\n"
View
50 bench/fasta/fasta.perl
@@ -4,13 +4,13 @@
# contributed by David Pyke
# tweaked by Danny Sauer
# Butchered by Jesse Millikan
+# 2.5 times faster by Reini Urban
use constant IM => 139968;
use constant IA => 3877;
use constant IC => 29573;
-use constant LINELENGTH => 60;
-
+my $LINELENGTH = 60;
my $LAST = 42;
sub makeCumulative {
@@ -26,27 +26,25 @@ sub makeRandomFasta {
my($id,$desc,$n,$genelist) = @_;
print ">$id $desc\n";
- my $pick, $r;
-
- while($n > 0){
- $pick='';
-
- # Get LINELENGTH chars or what's left of $n
- CHAR: foreach (1 .. ($n > LINELENGTH ? LINELENGTH : $n)){
- $rand = ($LAST = ($LAST * IA + IC) % IM) / IM;
-
- # Select gene and append it
- foreach (@$genelist){
- if($rand < $_->[1]){
- $pick .= $_->[0];
- next CHAR;
- }
- }
- }
-
- print "$pick\n";
- $n -= LINELENGTH;
+ my $rand;
+ my $pick= ' ' x 4096;
+ $pick = '';
+ while($n > 0){
+ # Get LINELENGTH chars or what's left of $n
+ foreach (1 .. ($n > $LINELENGTH ? $LINELENGTH : $n)){
+ $rand = ($LAST = ($LAST * IA + IC) % IM) / IM;
+ # Select gene and append it. $genelist(char,probs) is sorted by probs
+ foreach (@$genelist){
+ if($rand < $_->[1]){
+ $pick .= $_->[0];
+ last;
+ }
+ }
+ }
+ $pick .= "\n";
+ $n -= $LINELENGTH;
}
+ print $pick;
}
# Print $n characters of $s (repeated if nessary) with newlines every LINELENGTH
@@ -55,13 +53,13 @@ sub makeRepeatFasta {
print ">$id $desc\n";
- my $ss;
+ my $ss = '';
while($n > 0){
# Overfill $ss with $s
- $ss .= $s while length $ss < LINELENGTH;
+ $ss .= $s while length $ss < $LINELENGTH;
# Print LINELENGTH chars or whatever's left of $n
- print substr($ss,0,$n > LINELENGTH ? LINELENGTH : $n,""), "\n";
- $n -= LINELENGTH;
+ print substr($ss,0,$n > $LINELENGTH ? $LINELENGTH : $n,""), "\n";
+ $n -= $LINELENGTH;
}
}
View
141 bench/nbody/nbody.perl-2.perl
@@ -0,0 +1,141 @@
+# The Computer Language Shootout
+# http://shootout.alioth.debian.org/
+#
+# contributed by Christoph Bauer
+# converted into Perl by Márton Papp
+# fixed and cleaned up by Danny Sauer
+# optimized by Jesse Millikan
+# optimized by Reini Urban
+
+use constant PI => 3.141592653589793;
+use constant SOLAR_MASS => (4 * PI * PI);
+use constant DAYS_PER_YEAR => 365.24;
+
+sub energy;
+sub advance($);
+sub offset_momentum;
+
+my (@xs, @ys, @zs, @vxs, @vys, @vzs, @mass, $last);
+my ($energy, $offset_momentum, $advance);
+BEGIN {
+# Global lexicals for arrays.
+# Almost every iteration is a range, so I keep the last index rather than a count.
+
+# @ns = ( sun, jupiter, saturn, uranus, neptune )
+@xs = (0, 4.84143144246472090e+00, 8.34336671824457987e+00, 1.28943695621391310e+01, 1.53796971148509165e+01);
+@ys = (0, -1.16032004402742839e+00, 4.12479856412430479e+00, -1.51111514016986312e+01, -2.59193146099879641e+01);
+@zs = (0, -1.03622044471123109e-01, -4.03523417114321381e-01, -2.23307578892655734e-01, 1.79258772950371181e-01);
+@vxs = map {$_ * DAYS_PER_YEAR}
+ (0, 1.66007664274403694e-03, -2.76742510726862411e-03, 2.96460137564761618e-03, 2.68067772490389322e-03);
+@vys = map {$_ * DAYS_PER_YEAR}
+ (0, 7.69901118419740425e-03, 4.99852801234917238e-03, 2.37847173959480950e-03, 1.62824170038242295e-03);
+@vzs = map {$_ * DAYS_PER_YEAR}
+ (0, -6.90460016972063023e-05, 2.30417297573763929e-05, -2.96589568540237556e-05, -9.51592254519715870e-05);
+@mass = map {$_ * SOLAR_MASS}
+ (1, 9.54791938424326609e-04, 2.85885980666130812e-04, 4.36624404335156298e-05, 5.15138902046611451e-05);
+$last = $#xs;
+
+# Optimize array accesses: $a[const] are optimized to AELEMFAST, $a[$lexical] not.
+# So unroll the loops in macro-like fashion (2x times faster). We do it in a BEGIN block,
+# so perlcc can also benefit (again 2x faster).
+$energy = '
+sub energy
+{
+ my $e = 0.0;
+ my ($dx, $dy, $dz, $distance);';
+for my $i (0 .. $last) {
+ $energy .= "
+# loop $i..4
+ \$e += 0.5 * \$mass[$i] *
+ (\$vxs[$i] * \$vxs[$i] + \$vys[$i] * \$vys[$i] + \$vzs[$i] * \$vzs[$i]);
+";
+ for (my $j = $i + 1; $j < $last + 1; $j++) {
+ $energy .= "
+ # inner-loop $j..4
+ \$dx = \$xs[$i] - \$xs[$j];
+ \$dy = \$ys[$i] - \$ys[$j];
+ \$dz = \$zs[$i] - \$zs[$j];
+ \$distance = sqrt(\$dx * \$dx + \$dy * \$dy + \$dz * \$dz);
+ \$e -= (\$mass[$i] * \$mass[$j]) / \$distance;";
+ }
+}
+$energy .= '
+ return $e;
+}';
+eval $energy; die if $@;
+
+$advance = '
+sub advance($)
+{
+ my $dt = $_[0];
+ my ($mm, $mm2, $j, $dx, $dy, $dz, $distance, $mag);
+';
+# This is faster in the outer loop...
+for my $i (0..$last) {
+ # But not in the inner loop. Strange.
+ for ($j = $i + 1; $j < $last + 1; $j++) {
+ $advance .= "
+ # outer-loop $i..4
+ # inner-loop $j..4
+ \$dx = \$xs[$i] - \$xs[$j];
+ \$dy = \$ys[$i] - \$ys[$j];
+ \$dz = \$zs[$i] - \$zs[$j];
+ \$distance = sqrt(\$dx * \$dx + \$dy * \$dy + \$dz * \$dz);
+ \$mag = \$dt / (\$distance * \$distance * \$distance);
+ \$mm = \$mass[$i] * \$mag;
+ \$mm2 = \$mass[$j] * \$mag;
+ \$vxs[$i] -= \$dx * \$mm2;
+ \$vxs[$j] += \$dx * \$mm;
+ \$vys[$i] -= \$dy * \$mm2;
+ \$vys[$j] += \$dy * \$mm;
+ \$vzs[$i] -= \$dz * \$mm2;
+ \$vzs[$j] += \$dz * \$mm;";
+ }
+}
+# We're done with planet $i at this point
+for my $i (0..$last) {
+ $advance .= "
+ \$xs[$i] += \$dt * \$vxs[$i];
+ \$ys[$i] += \$dt * \$vys[$i];
+ \$zs[$i] += \$dt * \$vzs[$i];";
+}
+ $advance .= '
+}';
+eval $advance; die if $@;
+
+$offset_momentum = ';
+sub offset_momentum
+{
+ my $px = 0.0;
+ my $py = 0.0;
+ my $pz = 0.0;
+ my $mass;
+';
+for my $i (0 .. $last) {
+ $offset_momentum .= "
+ \$mass = \$mass[$i];
+ \$px += \$vxs[$i] * \$mass;
+ \$py += \$vys[$i] * \$mass;
+ \$pz += \$vzs[$i] * \$mass;";
+}
+$offset_momentum .= '
+ $vxs[0] = - $px / SOLAR_MASS;
+ $vys[0] = - $py / SOLAR_MASS;
+ $vzs[0] = - $pz / SOLAR_MASS;
+}';
+eval $offset_momentum; die if $@;
+
+} #BEGIN
+
+offset_momentum();
+printf ("%.9f\n", energy());
+
+my $n = $ARGV[0];
+$n =~ s/[,_]//g; # allow 50_000_000 or 50,000,000
+
+# This does not, in fact, consume N*4 bytes of memory
+for (1 .. $n) {
+ advance(0.01);
+}
+
+printf ("%.9f\n", energy());
View
151 bench/nbody/nbody.perl-2a.perl
@@ -0,0 +1,151 @@
+# The Computer Language Shootout
+# http://shootout.alioth.debian.org/
+#
+# contributed by Christoph Bauer
+# converted into Perl by Márton Papp
+# fixed and cleaned up by Danny Sauer
+# optimized by Jesse Millikan
+# optimized by Reini Urban
+
+use constant PI => 3.141592653589793;
+use constant SOLAR_MASS => (4 * PI * PI);
+use constant DAYS_PER_YEAR => 365.24;
+
+sub energy;
+sub advance($);
+sub offset_momentum;
+
+my (@xs, @ys, @zs, @vxs, @vys, @vzs, @mass, $last);
+my ($energy, $offset_momentum, $advance);
+BEGIN {
+# Global lexicals for arrays.
+# Almost every iteration is a range, so I keep the last index rather than a count.
+
+# @ns = ( sun, jupiter, saturn, uranus, neptune )
+@xs = (0, 4.84143144246472090e+00, 8.34336671824457987e+00, 1.28943695621391310e+01, 1.53796971148509165e+01);
+@ys = (0, -1.16032004402742839e+00, 4.12479856412430479e+00, -1.51111514016986312e+01, -2.59193146099879641e+01);
+@zs = (0, -1.03622044471123109e-01, -4.03523417114321381e-01, -2.23307578892655734e-01, 1.79258772950371181e-01);
+@vxs = map {$_ * DAYS_PER_YEAR}
+ (0, 1.66007664274403694e-03, -2.76742510726862411e-03, 2.96460137564761618e-03, 2.68067772490389322e-03);
+@vys = map {$_ * DAYS_PER_YEAR}
+ (0, 7.69901118419740425e-03, 4.99852801234917238e-03, 2.37847173959480950e-03, 1.62824170038242295e-03);
+@vzs = map {$_ * DAYS_PER_YEAR}
+ (0, -6.90460016972063023e-05, 2.30417297573763929e-05, -2.96589568540237556e-05, -9.51592254519715870e-05);
+@mass = map {$_ * SOLAR_MASS}
+ (1, 9.54791938424326609e-04, 2.85885980666130812e-04, 4.36624404335156298e-05, 5.15138902046611451e-05);
+$last = $#xs;
+
+# Optimize array accesses: $a[const] are optimized to AELEMFAST, $a[$lexical] not.
+# So unroll the loops in macro-like fashion (2x times faster). We do it in a BEGIN block,
+# so perlcc can also benefit (again 2x faster).
+sub qv {
+ my $s = shift;
+ my $env = shift;
+ # expand our local loop vars
+ $s =~ s/(\$\w+?)\b/exists($env->{$1})?$env->{$1}:$1/sge;
+ $s
+}
+
+$energy = '
+sub energy
+{
+ my $e = 0.0;
+ my ($dx, $dy, $dz, $distance);';
+ for my $i (0 .. $last) {
+ my $env = {'$i'=>$i,'$last'=>$last};
+ $energy .= qv('
+ # outer-loop $i..4
+ $e += 0.5 * $mass[$i] *
+ ($vxs[$i] * $vxs[$i] + $vys[$i] * $vys[$i] + $vzs[$i] * $vzs[$i]);', $env);
+ for (my $j = $i + 1; $j < $last + 1; $j++) {
+ $env->{'$j'} = $j;
+ $energy .= qv('
+ # inner-loop $j..4
+ $dx = $xs[$i] - $xs[$j];
+ $dy = $ys[$i] - $ys[$j];
+ $dz = $zs[$i] - $zs[$j];
+ $distance = sqrt($dx * $dx + $dy * $dy + $dz * $dz);
+ $e -= ($mass[$i] * $mass[$j]) / $distance;', $env);
+ }
+ }
+ $energy .= '
+ return $e;
+}';
+eval $energy; die if $@;
+
+$advance = '
+sub advance($)
+{
+ my $dt = $_[0];
+ my ($mm, $mm2, $j, $dx, $dy, $dz, $distance, $mag);';
+ for my $i (0..$last) {
+ my $env = {'$i'=>$i};
+ for (my $j = $i + 1; $j < $last + 1; $j++) {
+ $env->{'$j'} = $j;
+ $advance .= qv('
+ # outer-loop $i..4
+ # inner-loop $j..4
+ $dx = $xs[$i] - $xs[$j];
+ $dy = $ys[$i] - $ys[$j];
+ $dz = $zs[$i] - $zs[$j];
+ $distance = sqrt($dx * $dx + $dy * $dy + $dz * $dz);
+ $mag = $dt / ($distance * $distance * $distance);
+ $mm = $mass[$i] * $mag;
+ $mm2 = $mass[$j] * $mag;
+ $vxs[$i] -= $dx * $mm2;
+ $vxs[$j] += $dx * $mm;
+ $vys[$i] -= $dy * $mm2;
+ $vys[$j] += $dy * $mm;
+ $vzs[$i] -= $dz * $mm2;
+ $vzs[$j] += $dz * $mm;', $env);
+ }
+ }
+ # We're done with planet $i at this point
+ for my $i (0..$last) {
+ my $env = {'$i'=>$i};
+ $advance .= qv('
+ $xs[$i] += $dt * $vxs[$i];
+ $ys[$i] += $dt * $vys[$i];
+ $zs[$i] += $dt * $vzs[$i];', $env);
+ }
+ $advance .= '
+}';
+eval $advance; die if $@;
+
+$offset_momentum = ';
+sub offset_momentum
+{
+ my $px = 0.0;
+ my $py = 0.0;
+ my $pz = 0.0;
+ my $mass;
+';
+for my $i (0 .. $last) {
+ my $env = {'$i'=>$i};
+ $offset_momentum .= qv('
+ $mass = $mass[$i];
+ $px += $vxs[$i] * $mass;
+ $py += $vys[$i] * $mass;
+ $pz += $vzs[$i] * $mass;', $env);
+}
+$offset_momentum .= '
+ $vxs[0] = - $px / SOLAR_MASS;
+ $vys[0] = - $py / SOLAR_MASS;
+ $vzs[0] = - $pz / SOLAR_MASS;
+}';
+eval $offset_momentum; die if $@;
+
+} #BEGIN
+
+offset_momentum();
+printf ("%.9f\n", energy());
+
+my $n = $ARGV[0];
+$n =~ s/[,_]//g; # allow 50_000_000 or 50,000,000
+
+# This does not, in fact, consume N*4 bytes of memory
+for (1 .. $n) {
+ advance(0.01);
+}
+
+printf ("%.9f\n", energy());
View
16 bencher/makefiles/my.linux.ini
@@ -13,7 +13,7 @@
[measure]
; how many repeated measurements at the same [testrange] value?
-runs = 6
+runs = 3
; repeat measurements at every [testrange] value
; or just the largest? (True or False)
@@ -94,13 +94,13 @@ ignore =
; x=y z - additionally measure source file x with implementations y and z
python = compiledpython
-
+perl = compiledperl
[build]
make =
- compiledpython
+ compiledpython compiledperl
@@ -117,7 +117,8 @@ JDKC = /usr/bin/javac
GCC = /usr/bin/gcc
-
+PERL = /usr/local/bin/perl
+PERLCC = /usr/local/bin/perlcc
[commandlines]
@@ -136,6 +137,9 @@ GCC = /usr/bin/gcc
python = $PYTHON %X %A
compiledpython = $PYTHON %B.pyo %A
+perl = $PERL %X %A
+compiledperl = $PERLCC %B %A
+
; (For multiprocessing make sure the extension is .py)
;python = $PYTHON -O %B.py %A
@@ -206,8 +210,8 @@ binarycmp =
; check output with ndiff and these parameters for the named test
-;chameneosredux = -fields 2-10
-;nbody = -abserr 1.0e-8
+chameneosredux = -fields 2-10
+nbody = -abserr 1.0e-8
Something went wrong with that request. Please try again.