chrislo-sourceclassifier 0.2.0 → 0.2.1

data/sources/perl/fibo.perl

@@ -1,15 +0,0 @@
-#!/usr/bin/perl
-# $Id: fibo.perl,v 1.5 2005-04-25 19:01:38 igouy-guest Exp $
-# http://www.bagley.org/~doug/shootout/
-
-use strict;
-use integer;
-
-# from Leif Stensson
-sub fib {
-    return $_[0] < 2 ? 1 : fib($_[0]-2) + fib($_[0]-1);
-}
-
-my $N = ($ARGV[0] < 1) ? 1 : $ARGV[0];
-my $fib = fib($N);
-print "$fib\n";

data/sources/perl/harmonic.perl

@@ -1,7 +0,0 @@
-#!/usr/bin/perl -w
-# The Great Computer Language Shootout
-# http://shootout.alioth.debian.org/
-# contributed by Greg Buchholz
-
-$sum += 1/$_ for 1..$ARGV[0];
-printf "%.9f\n", $sum;

data/sources/perl/hash.perl

@@ -1,23 +0,0 @@
-#!/usr/bin/perl
-# $Id: hash.perl,v 1.1.1.1 2004-05-19 18:09:55 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-
-# this program is modified from:
-#   http:#cm.bell-labs.com/cm/cs/who/bwk/interps/pap.html
-# Timing Trials, or, the Trials of Timing: Experiments with Scripting
-# and User-Interface Languages</a> by Brian W. Kernighan and
-# Christopher J. Van Wyk.
-
-use strict;
-
-my $n = $ARGV[0] || 1;
-my %X = ();
-my $c = 0;
-
-for my $i (1..$n) {
-    $X{sprintf('%x', $i)} = $i;
-}
-for my $i (reverse 1..$n) {
-    ++$c if exists $X{$i};
-}
-print "$c\n";

data/sources/perl/hash.perl-2.perl

@@ -1,17 +0,0 @@
-#!/usr/bin/perl
-use integer;
-
-$n = $ARGV[0] || 1;
-%X = ();
-$c = 0;
-keys %X=$n;
-for ($i=0; $i<$n;) {
-    $X{sprintf('%x', $i)} = ++$i;
-    $X{sprintf('%x', $i)} = ++$i;
-    $X{sprintf('%x', $i)} = ++$i;
-    $X{sprintf('%x', $i)} = ++$i;
-}
-for ($i=$n+1; $i>0;) {
-    $c+=exists($X{--$i}) + exists($X{--$i}) + exists($X{--$i}) + exists($X{--$i});
-}
-print $c,"\n";

data/sources/perl/hash.perl-3.perl

@@ -1,24 +0,0 @@
-#!/usr/bin/perl
-# $Id: hash.perl-3.perl,v 1.1 2004-11-10 06:34:44 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-
-# this program is modified from:
-#   http:#cm.bell-labs.com/cm/cs/who/bwk/interps/pap.html
-# Timing Trials, or, the Trials of Timing: Experiments with Scripting
-# and User-Interface Languages</a> by Brian W. Kernighan and
-# Christopher J. Van Wyk.
-
-use strict;
-
-my $n = $ARGV[0] || 1;
-my %X = ();
-keys %X = $n / 3;
-my $c = 0;
-
-for my $i (1..$n) {
-    $X{sprintf('%x', $i)} = $i;
-}
-for my $i (reverse 1..$n) {
-    ++$c if exists $X{$i};
-}
-print "$c\n";

data/sources/perl/hash2.perl

@@ -1,16 +0,0 @@
-#!/usr/bin/perl
-# $Id: hash2.perl,v 1.1.1.1 2004-05-19 18:10:02 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-# with help from Steve Fink
-
-use strict;
-
-my $n = ($ARGV[0] > 0) ? $ARGV[0] : 1;
-my %hash1 = ();
-$hash1{"foo_$_"} = $_ for 0..9999;
-my %hash2 = ();
-my($k, $v);
-for (1..$n) {
-    $hash2{$_} += $hash1{$_} while (defined ($_ = each %hash1));
-}
-print "$hash1{foo_1} $hash1{foo_9999} $hash2{foo_1} $hash2{foo_9999}\n";

data/sources/perl/heapsort.perl

@@ -1,65 +0,0 @@
-#!/usr/bin/perl 
-# $Id: heapsort.perl,v 1.1.1.1 2004-05-19 18:10:10 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-# Matt Harris suggested passing the array via typeglob
-
-use strict;
-
-use constant IM => 139968;
-use constant IA =>   3877;
-use constant IC =>  29573;
-
-use vars qw(@ra);
-
-my $LAST = 42;
-sub gen_random { ($_[0] * ($LAST = ($LAST * IA + IC) % IM)) / IM }
-
-sub heapsort ($\@) {
-    my $n = shift;
-    # use typeglob ra to refer to array.
-    local *ra = shift;
-
-    my($rra, $i, $j);
-
-    my $l = ($n >> 1) + 1;
-    my $ir = $n;
-    while (1) {
-	if ($l > 1) {
-	    $rra = $ra[--$l];
-	} else {
-	    $rra = $ra[$ir];
-	    $ra[$ir] = $ra[1];
-	    if (--$ir == 1) {
-		$ra[1] = $rra;
-		return;
-	    }
-	}
-	$i = $l;
-	$j = $l << 1;
-	while ($j <= $ir) {
-	    $j++ if (($j < $ir) && ($ra[$j] < $ra[$j+1]));
-	    if ($rra < $ra[$j]) {
-		$ra[$i] = $ra[$j];
-		$j += ($i = $j);
-	    } else {
-		$j = $ir + 1;
-	    }
-	}
-	$ra[$i] = $rra;
-    }
-}
-
-
-my $N = $ARGV[0];
-$N = 1 if ($N < 1);
-
-# create an array of N random doubles
-my @ary = ();
-for (my $i=1; $i<=$N; $i++) {
-    $ary[$i] = gen_random(1.0);
-}
-
-heapsort($N, @ary);
-
-printf("%.10f\n", $ary[-1]);
-

data/sources/perl/hello.perl

@@ -1,5 +0,0 @@
-#!/usr/bin/perl
-# $Id: hello.perl,v 1.1.1.1 2004-05-19 18:10:16 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-
-print "hello world\n";

data/sources/perl/knucleotide.perl-2.perl

@@ -1,30 +0,0 @@
-#  The Computer Language Benchmarks Game
-#  http://shootout.alioth.debian.org/
-#  contributed by Karl FORNER
-# (borrowed fasta loading routine from Kjetil Skotheim, 2005-11-29)
-# Corrected again by Jesse Millikan
-# revised by Kuang-che Wu
-
-my ($sequence);
-$/ = ">";
-/^THREE/ and $sequence = uc(join "", grep !/^THREE/, split /\n+/) while <STDIN>;
-
-my ($l,%h,$sum) = (length $sequence);
-foreach my $frame (1,2) {
-  %h = ();
-  update_hash_for_frame($frame);
-  $sum = $l - $frame + 1;
-  printf "$_ %.3f\n", $h{$_}*100/$sum for sort { $h{$b} <=> $h{$a} || $a cmp $b } keys %h;
-  print "\n";
-}
-
-foreach my $s (qw(GGT GGTA GGTATT GGTATTTTAATT GGTATTTTAATTTATAGT)) {
-  update_hash_for_frame(length($s));
-  printf "%d\t$s\n", $h{$s};
-}
-
-sub update_hash_for_frame {
-  my $frame = $_[0];
-  $h{substr($sequence,$_,$frame)}++ foreach (0..($l - $frame));
-}
-

data/sources/perl/lists.perl

@@ -1,48 +0,0 @@
-#!/usr/bin/perl 
-# $Id: lists.perl,v 1.1.1.1 2004-05-19 18:10:24 bfulgham Exp $
-use strict;
-
-my $SIZE = 10000;
-
-my $ITER = $ARGV[0];
-$ITER = 1 if ($ITER < 1);
-
-my $result = 0;
-while ($ITER--) {
-    $result = &test_lists();
-}
-print "$result\n";
-
-sub test_lists {
-    # create a list of integers (Li1) from 1 to SIZE
-    my @Li1 = (1..$SIZE);
-    # copy the list to Li2 (not by individual items)
-    my @Li2 = @Li1;
-    my @Li3 = ();
-    # remove each individual item from left side of Li2 and
-    # append to right side of Li3 (preserving order)
-    push(@Li3, shift @Li2) while (@Li2);
-    # Li2 must now be empty
-    # remove each individual item from right side of Li3 and
-    # append to right side of Li2 (reversing list)
-    push(@Li2, pop @Li3) while (@Li3);
-    # Li3 must now be empty
-    # reverse Li1 in place
-    @Li1 = reverse @Li1;
-    # check that first item is now SIZE
-    return(0) if $Li1[0] != $SIZE;
-    # compare Li1 and Li2 for equality
-    my $len1 = scalar(@Li1);
-    my $len2 = scalar(@Li2);
-    my $lists_equal = ($len1 == $len2);
-    return(0) if not $lists_equal;
-    for my $i (0..($len1-1)) {
-	if ($Li1[$i] != $Li2[$i]) {
-	    $lists_equal = 0;
-	    last;
-	}
-    }
-    return(0) if not $lists_equal;
-    # return the length of the list
-    return($len1);
-}

data/sources/perl/mandelbrot.perl-2.perl

@@ -1,32 +0,0 @@
-# The Computer Language Shootout
-# http://shootout.alioth.debian.org/
-# implemented by Greg Buchholz
-# streamlined by Kalev Soikonen
-
-sub ITER ()	{ 50 }
-sub LIMITSQR ()	{ 2.0 ** 2 }
-
-my ($w, $h, $i);
-my ($Cr, $Ci, $Zr, $Zi, $Tr, $Ti);
-
-sub dot {
-    $Cr = 2 * $_[0] / $w - 1.5;
-    $Ci = 2 * $_[1] / $h - 1.0;
-
-    $Zr = $Zi = $Tr = $Ti = 0.0;
-    $i = ITER;
-    (
-	$Zi = 2.0 * $Zr * $Zi + $Ci,
-	$Zr = $Tr - $Ti + $Cr,
-	$Ti = $Zi * $Zi,
-	$Tr = $Zr * $Zr
-    ) until ($Tr + $Ti > LIMITSQR || !$i--);
-    return ($i == -1);
-}
-
-$w = $h = shift || 80;
-print "P4\n$w $h\n";
-for my $y (0..$h-1) {
-    print pack 'B*', pack 'C*', map dot($_, $y), 0..$w-1;
-}
-

data/sources/perl/matrix.perl

@@ -1,59 +0,0 @@
-#!/usr/bin/perl 
-# $Id: matrix.perl,v 1.1.1.1 2004-05-19 18:10:34 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-
-# This program based on the original from:
-# "The What, Why, Who, and Where of Python" By Aaron R. Watters
-# http://www.networkcomputing.com/unixworld/tutorial/005/005.html
-
-# modified to pass rows and cols, and avoid matrix size checks
-# I've sped up the original quite a bit by removing some loop
-# invariants and declaring "use integer"
-
-use strict;
-use integer;
-
-my $size = 30;
-
-sub mkmatrix {
-    my($rows, $cols) = @_;
-    --$rows; --$cols;
-    my $count = 1;
-    my @mx = ();
-    foreach (0 .. $rows) {
-	my @row = ();
-	$row[$_] = $count++ foreach (0 .. $cols);
-	push(@mx, \@row);
-    }
-    return(\@mx);
-}
-
-sub mmult {
-    my ($rows, $cols, $m1, $m2) = @_;
-    my @m3 = ();
-    --$rows; --$cols;
-    for my $i (0 .. $rows) {
-	my @row = ();
-	my $m1i = $m1->[$i];
-	for my $j (0 .. $cols) {
-	    my $val = 0;
-	    for my $k (0 .. $cols) {
-		$val += $m1i->[$k] * $m2->[$k]->[$j];
-	    }
-	    push(@row, $val);
-	}
-	push(@m3, \@row);
-    }
-    return(\@m3);
-}
-
-my $N = $ARGV[0] || 1;
-
-my $m1 = mkmatrix($size, $size);
-my $m2 = mkmatrix($size, $size);
-my $mm;
-while ($N--) {
-    $mm = mmult($size, $size, $m1, $m2);
-}
-print "$mm->[0]->[0] $mm->[2]->[3] $mm->[3]->[2] $mm->[4]->[4]\n";
-

data/sources/perl/message.perl

@@ -1,27 +0,0 @@
-# The Computer Language Benchmarks Game
-# http://shootout.alioth.debian.org/
-# contributed by Sean O'Rourke
-
-use threads;
-use Thread::Queue;
-
-my $t = 500;
-my $n = shift;
-
-my @q : shared;
-@q = map { new Thread::Queue } 1..$t;
-
-for my $i (1..$t-1) {
-    (async {
-        while (!$done) {
-            $q[$i]->enqueue(1+$q[$i-1]->dequeue);
-        }
-    })->detach;
-}
-
-for (1..$n) {
-    $q[0]->enqueue(0);
-    $sum += $q[-1]->dequeue + 1;
-}
-
-print "$sum\n";

data/sources/perl/methcall.perl

@@ -1,66 +0,0 @@
-#!/usr/bin/perl
-# $Id: methcall.perl,v 1.1.1.1 2004-05-19 18:10:41 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-# with help from Ben Tilly
-
-package Toggle;
-
-sub new {
-    my($class, $start_state) = @_;
-    bless( { Bool => $start_state }, $class );
-}
-
-sub value {
-    (shift)->{Bool};
-}
-
-sub activate {
-    my $self = shift;
-    $self->{Bool} ^= 1;
-    return($self);
-}
-
-
-package NthToggle;
-our @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];
-    $NUM = 1 if ($NUM < 1);
-
-    my $val = 1;
-    my $toggle = Toggle->new($val);
-    for (1..$NUM) {
-	$val = $toggle->activate->value;
-    }
-    print (($val) ? "true\n" : "false\n");
-
-    $val = 1;
-    my $ntoggle = NthToggle->new($val, 3);
-    for (1..$NUM) {
-	$val = $ntoggle->activate->value;
-    }
-    print (($val) ? "true\n" : "false\n");
-}
-
-main();