chrislo-sourceclassifier 0.2.0

data/sources/perl/moments.perl

@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+# $Id: moments.perl,v 1.1.1.1 2004-05-19 18:10:48 bfulgham Exp $
+# http://www.bagley.org/~doug/shootout/
+
+use strict;
+
+my @nums = <STDIN>;
+my $sum = 0;
+foreach (@nums) { $sum += $_ }
+my $n = scalar(@nums);
+my $mean = $sum/$n;
+my $average_deviation = 0;
+my $standard_deviation = 0;
+my $variance = 0;
+my $skew = 0;
+my $kurtosis = 0;
+foreach (@nums) {
+    my $deviation = $_ - $mean;
+    $average_deviation += abs($deviation);
+    $variance += $deviation**2;
+    $skew += $deviation**3;
+    $kurtosis += $deviation**4;
+}
+$average_deviation /= $n;
+$variance /= ($n - 1);
+$standard_deviation = sqrt($variance);
+
+if ($variance) {
+    $skew /= ($n * $variance * $standard_deviation);
+    $kurtosis = $kurtosis/($n * $variance * $variance) - 3.0;
+}
+
+@nums = sort { $a <=> $b } @nums;
+my $mid = int($n/2);
+my $median = ($n % 2) ? $nums[$mid] : ($nums[$mid] + $nums[$mid-1])/2;
+
+printf("n:                  %d\n", $n);
+printf("median:             %f\n", $median);
+printf("mean:               %f\n", $mean);
+printf("average_deviation:  %f\n", $average_deviation);
+printf("standard_deviation: %f\n", $standard_deviation);
+printf("variance:           %f\n", $variance);
+printf("skew:               %f\n", $skew);
+printf("kurtosis:           %f\n", $kurtosis);

data/sources/perl/nbody.perl

@@ -0,0 +1,108 @@
+# 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
+
+use constant PI            => 3.141592653589793;
+use constant SOLAR_MASS    => (4 * PI * PI);
+use constant DAYS_PER_YEAR => 365.24;
+
+#  Globals for arrays... Oh well.
+#  Almost every iteration is a range, so I keep the last index rather than a count.
+my (@xs, @ys, @zs, @vxs, @vys, @vzs, @mass, $last);
+
+sub advance($)
+{
+  my ($dt) = @_;
+  my ($mm, $mm2, $j, $dx, $dy, $dz, $distance, $mag);
+  
+#  This is faster in the outer loop...
+  for (0..$last) {
+#  But not in the inner loop. Strange.
+    for ($j = $_ + 1; $j < $last + 1; $j++) {
+      $dx = $xs[$_] - $xs[$j];
+      $dy = $ys[$_] - $ys[$j];
+      $dz = $zs[$_] - $zs[$j];
+      $distance = sqrt($dx * $dx + $dy * $dy + $dz * $dz);
+      $mag = $dt / ($distance * $distance * $distance);
+      $mm = $mass[$_] * $mag;
+      $mm2 = $mass[$j] * $mag;
+      $vxs[$_] -= $dx * $mm2;
+      $vxs[$j] += $dx * $mm;
+      $vys[$_] -= $dy * $mm2;
+      $vys[$j] += $dy * $mm;
+      $vzs[$_] -= $dz * $mm2;
+      $vzs[$j] += $dz * $mm;
+    }  
+
+# We're done with planet $_ at this point
+# This could be done in a seperate loop, but it's slower
+    $xs[$_] += $dt * $vxs[$_];
+    $ys[$_] += $dt * $vys[$_];
+    $zs[$_] += $dt * $vzs[$_];
+  }
+}
+
+sub energy
+{
+  my ($e, $i, $dx, $dy, $dz, $distance);
+
+  $e = 0.0;
+  for $i (0..$last) {
+    $e += 0.5 * $mass[$i] *
+          ($vxs[$i] * $vxs[$i] + $vys[$i] * $vys[$i] + $vzs[$i] * $vzs[$i]);
+    for ($i + 1..$last) {
+      $dx = $xs[$i] - $xs[$_];
+      $dy = $ys[$i] - $ys[$_];
+      $dz = $zs[$i] - $zs[$_];
+      $distance = sqrt($dx * $dx + $dy * $dy + $dz * $dz);
+      $e -= ($mass[$i] * $mass[$_]) / $distance;
+    }
+  }
+  return $e;
+}
+
+sub offset_momentum
+{
+  my ($px, $py, $pz) = (0.0, 0.0, 0.0);
+
+  for (0..$last) {
+    $px += $vxs[$_] * $mass[$_];
+    $py += $vys[$_] * $mass[$_];
+    $pz += $vzs[$_] * $mass[$_];
+  }
+  $vxs[0] = - $px / SOLAR_MASS;
+  $vys[0] = - $py / SOLAR_MASS;
+  $vzs[0] = - $pz / SOLAR_MASS;
+}
+
+# @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 - 1;
+
+offset_momentum();
+printf ("%.9f\n", energy());
+
+my $n = $ARGV[0];
+
+# This does not, in fact, consume N*4 bytes of memory
+for (1..$n){
+  advance(0.01);
+}
+
+printf ("%.9f\n", energy());
+

data/sources/perl/nestedloop.perl

@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+# $Id: nestedloop.perl,v 1.1.1.1 2004-05-19 18:10:57 bfulgham Exp $
+# http://www.bagley.org/~doug/shootout/
+
+use strict;
+
+my $n = ($ARGV[0] > 0) ? $ARGV[0] : 1;
+my $x = 0;
+my $a = $n;
+while ($a--) {
+    my $b = $n;
+    while ($b--) {
+	my $c = $n;
+	while ($c--) {
+	    my $d = $n;
+	    while ($d--) {
+		my $e = $n;
+		while ($e--) {
+		    my $f = $n;
+		    while ($f--) {
+			$x++;
+		    }
+		}
+	    }
+	}
+    }
+}
+print "$x\n";

data/sources/perl/nsieve.perl-2.perl

@@ -0,0 +1,41 @@
+# The Computer Language Benchmarks Game
+# http://shootout.alioth.debian.org/
+#
+# contributed by David Pyke, March 2005
+# optimized by Steffen Mueller, Sept 2007
+
+use integer;
+use strict;
+
+sub nsieve {
+   my ($m) = @_;
+   my @a = (1) x $m;
+
+   my $count = 0;
+   foreach my $i (2..$m-1) {
+      if ($a[$i]) {
+         for (my $j = $i + $i; $j < $m; $j += $i){
+            $a[$j] = 0;
+         }
+         ++$count;
+      }
+   }
+   return $count;
+}
+
+
+sub nsieve_test {
+   my($n) = @_;
+
+   my $m = (1<<$n) * 10000;
+   my $ncount= nsieve($m);
+   printf "Primes up to %8u %8u\n", $m, $ncount;
+}
+
+
+my $N = ($ARGV[0] < 1) ? 1 : $ARGV[0];
+nsieve_test($N);
+nsieve_test($N-1)  if $N >= 1;
+nsieve_test($N-2)  if $N >= 2;
+
+

data/sources/perl/nsieve.perl-4.perl

@@ -0,0 +1,43 @@
+# The Computer Language Benchmarks Game
+# http://shootout.alioth.debian.org/
+#
+# contributed by David Pyke, March 2005
+# optimized by Steffen Mueller, Sept 2007
+# optimized by Laimonas Vėbra, Nov 2007
+
+use integer;
+use strict;
+
+
+sub nsieve {
+   my ($m) = @_;
+   my $i, my $j, my $a;
+   my $count = 0;
+   
+   $a = 0 x $m;
+
+   for($i = 2; $i < $m; $i++) {
+      if (substr($a, $i, 1) ne '1') {
+         for ($j = $i + $i; $j < $m; $j += $i){
+            substr($a, $j, 1) = '1';
+         }
+         ++$count;
+      }
+   }
+   return $count;
+}
+
+
+sub nsieve_test {
+   my($n) = @_;
+
+   my $m = (1<<$n) * 10000;
+   my $ncount= nsieve($m);
+   printf "Primes up to %8u %8u\n", $m, $ncount;
+}
+
+my $N = ($ARGV[0] < 1) ? 1 : $ARGV[0];
+
+nsieve_test($N);
+nsieve_test($N-1)  if $N >= 1;
+nsieve_test($N-2)  if $N >= 2;

data/sources/perl/nsievebits.perl

@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+
+# The Great Computer Language Shootout
+# http://shootout.alioth.debian.org/
+# nsieve-bits benchmark
+# contributed by Joel Hoffman, 2005-03-28
+
+use strict;
+
+sub nsieve {
+   my $mx = shift;
+   vec(my $vec,$mx,1)=0;
+   my $count=0;
+   for my $idx (2..$mx) {   
+      unless (vec($vec,$idx,1)) {
+         $count++;
+         for (my $i=2 * $idx; $i<=$mx; $i+=$idx) {
+            vec($vec,$i,1)=1;
+         }
+      }
+   }
+   $count;
+}
+
+sub test {
+   my $n = shift;
+   my $mx = 10000 * (2**$n);
+   printf "Primes up to %8d %8d\n",$mx,nsieve($mx);
+}
+
+for (0,1,2) {
+   if ($ARGV[0] > $_) {
+      test($ARGV[0] - $_)
+   }
+}
+
+

data/sources/perl/objinst.perl

@@ -0,0 +1,73 @@
+#!/usr/bin/perl 
+# $Id: objinst.perl,v 1.1.1.1 2004-05-19 18:11:03 bfulgham Exp $
+# http://www.bagley.org/~doug/shootout/
+
+use strict;
+
+
+package Toggle;
+
+sub new {
+    my($class, $start_state) = @_;
+    bless( { Bool => $start_state }, $class );
+}
+
+sub value {
+    my $self = shift;
+    return($self->{Bool});
+}
+
+sub activate {
+    my $self = shift;
+    $self->{Bool} ^= 1;
+    return($self);
+}
+
+
+package NthToggle;
+@NthToggle::ISA = qw(Toggle);
+
+sub new {
+    my($class, $start_state, $max_counter) = @_;
+    my $self = $class->SUPER::new($start_state);
+    $self->{CountMax} = $max_counter;
+    $self->{Counter} = 0;
+    return($self);
+}
+
+sub activate {
+    my $self = shift;
+    if (++$self->{Counter} >= $self->{CountMax}) {
+	$self->{Bool} ^= 1;
+	$self->{Counter} = 0;
+    }
+    return($self);
+}
+
+
+package main;
+
+sub main {
+    my $NUM = ($ARGV[0] > 0) ? $ARGV[0] : 1;
+
+    my $toggle = Toggle->new(1);
+    for (1..5) {
+	print (($toggle->activate->value) ? "true\n" : "false\n");
+    }
+    for (1..$NUM) {
+	$toggle = Toggle->new(1);
+    }
+
+    print "\n";
+
+    my $ntoggle = NthToggle->new(1, 3);
+    for (1..8) {
+	print (($ntoggle->activate->value) ? "true\n" : "false\n");
+    }
+    for (1..$NUM) {
+	$ntoggle = NthToggle->new(1, 3);
+    }
+}
+
+main();
+

data/sources/perl/partialsums.perl-3.perl

@@ -0,0 +1,31 @@
+# The Computer Language Shootout
+# http://shootout.alioth.debian.org/
+# Contributed by Emanuele Zeppieri
+
+my $N = shift || 2_500_000;
+
+my ($s0, $s1, $s2, $s3, $s4, $s5, $s6, $s7, $s8, $k2, $k3, $ksin, $kcos);
+my $alt = -1;
+sub TWO_THIRDS () { 2/3 }
+
+for (1..$N) {
+    $s0 += TWO_THIRDS ** ($_ - 1);
+    $s1 += 1 / sqrt;
+    $s2 += 1 / ( $_ * ($_ + 1));
+    $s3 += 1 / ( ($k3 = ($k2 = $_ * $_) * $_) * ($ksin = sin) * $ksin );
+    $s4 += 1 / ( $k3 * ($kcos = cos) * $kcos );
+    $s5 += 1 / $_;
+    $s6 += 1 / $k2;
+    $s7 += ($alt = -$alt) / $_;
+    $s8 += $alt / (2 * $_ - 1)
+}
+
+printf "%0.9f\t(2/3)^k\n"             , $s0;
+printf "%0.9f\tk^-0.5\n"              , $s1;
+printf "%0.9f\t1/k(k+1)\n"            , $s2;
+printf "%0.9f\tFlint Hills\n"         , $s3;
+printf "%0.9f\tCookson Hills\n"       , $s4;
+printf "%0.9f\tHarmonic\n"            , $s5;
+printf "%0.9f\tRiemann Zeta\n"        , $s6;
+printf "%0.9f\tAlternating Harmonic\n", $s7;
+printf "%0.9f\tGregory\n"             , $s8

data/sources/perl/pidigits.perl

@@ -0,0 +1,52 @@
+# The Computer Language Shootout
+#   http://shootout.alioth.debian.org/
+#
+#   contributed by Robert Bradshaw
+#      modified by Ruud H.G.van Tol
+#      modified by Emanuele Zeppieri
+
+use strict;
+
+use Math::BigInt lib => 'GMP';
+
+die 'Math::BigInt::GMP missing!'
+    if Math::BigInt->config->{lib} ne 'Math::BigInt::GMP';
+
+my $z0 = Math::BigInt->new(1);
+my $z1 = Math::BigInt->new(0);
+my $z2 = Math::BigInt->new(1);
+
+sub extract_digit { return scalar( ($z0 * $_[0] + $z1) / $z2 ) }
+
+sub compose {
+    if ( defined $_[3] ) {
+        $z1->bmul( $_[0] )->badd( $_[1] * $z2 )
+    } else {
+        $z1->bmul( $_[2] )->badd( $_[1] * $z0 )
+    }
+    $z0->bmul( $_[0] );
+    $z2->bmul( $_[2] );
+    return
+}
+
+my $n = $ARGV[0];
+($,, $\) = ("\t", "\n");
+my ($i, $s, $d); my $k = 0;
+
+# main loop
+for $i (1..$n) {
+    while (
+        $z0->bcmp($z2) == 1 || ( $d = extract_digit(3) ) != extract_digit(4)
+    ) {
+        # y not safe
+        $k++; compose($k, 4*$k+2, 2*$k+1)
+    }
+    compose(10, -10*$d, 1, 1);
+    $s .= $d;
+
+    unless ( $i % 10 ) { print $s, ":$i"; undef $s }
+}
+
+$s .= ' ' x (10-$i) if $i = $n % 10;
+
+print $s, ":$n" if $s