chrislo-sourceclassifier 0.2.0 → 0.2.1

data/sources/perl/pidigits.perl-2.perl

@@ -1,47 +0,0 @@
-# The Computer Language Benchmarks Game
-#   http://shootout.alioth.debian.org/
-#
-#   contributed by Robert Bradshaw
-#   modified by Ruud H.G.van Tol
-#   modified by Emanuele Zeppieri
-#   modified to use Math:GMP by Kuang-che Wu
-
-use strict;
-use Math::GMP;
-
-my($z0, $z1, $z2) = map Math::GMP->new($_),1,0,1;
-
-sub extract_digit { return ($z0*$_[0]+$z1)/$z2; }
-
-sub compose {
-    if ( defined $_[3] ) {
-        $z1 = $z1*$_[0]+$_[1]*$z2;
-    } else {
-        $z1 = $z1*$_[2]+$_[1]*$z0;
-    }
-    $z0 = $z0*$_[0];
-    $z2 = $z2*$_[2];
-    return;
-}
-
-my $n = $ARGV[0];
-($,, $\) = ("\t", "\n");
-my ($i, $s, $d); my $k = 0;
-
-# main loop
-for $i (1..$n) {
-    while (
-        $z0>$z2 || ( $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

data/sources/perl/process.perl

@@ -1,50 +0,0 @@
-#!/usr/bin/perl
-
-# perl thread benchmark for The Great Computer Language Shootout
-# http://shootout.alioth.debian.org/
-# Contributed by Steve Clark
-
-# perl threads creates an interpreter per thread so this won't
-# be pretty.
-use threads;
-
-# The thread code blocks til it gets a message, then sends it
-# Argument is reference to last thread
-sub inc_thread {
-    my $thr = shift;
-    my ($num) = $thr->join;
-    $num++;
-    return ($num);
-}
-
-# special thread to kick off the chain
-sub zero_thread {
-    return (0);
-}
-
-
-# Algorithm:
-#   Create n threads from 1 to n
-#   Each thread x has ref to thread x-1
-#   Creates extra zero_thread to send 0 to start of chain
-#   prints return of last thread created
-
-sub dothread {
-    my $n = shift;
-    my $thread = threads->new(\&zero_thread);
-
-    for ($i = 1; $i <= $n; $i++) {
-	$thread = threads->new(\&inc_thread, $thread);
-    }
-
-    # Now wait for end
-    my $num = $thread->join;
-
-    # print the result
-    print "$num\n";
-}
-
-
-my $NUM = $ARGV[0];
-$NUM = 1 if ($NUM < 1);
-dothread ($NUM);

data/sources/perl/prodcons.perl

@@ -1,47 +0,0 @@
-#!/usr/bin/perl
-# $Id: prodcons.perl,v 1.3 2005-05-13 16:24:18 igouy-guest Exp $
-# http://www.bagley.org/~doug/shootout/ 
-
-use strict;
-use Thread qw(cond_wait cond_signal);
-
-my $count = 0;
-my $data = 0;
-my $produced = 0;
-my $consumed = 0;
-
-sub consumer {
-    my $n = shift;
-    while (1) {
-	lock($count);
-	cond_wait($count) while ($count == 0);
-	my $i = $data;
-	$count = 0;
-	$consumed++;
-	last if ($i == $n);
-	cond_signal($count);
-    }
-}
-
-sub producer {
-    my $n = shift;
-    for (my $i=1; $i<=$n; $i++) {
-	lock($count);
-	cond_wait($count) while ($count == 1);
-	$data = $i;
-	$count = 1;
-	$produced++;
-	cond_signal($count);
-    }
-}
-
-sub main {
-    my $n = ($ARGV[0] < 1) ? 1 : $ARGV[0];
-    my $p = Thread->new(\&producer, $n);
-    my $c = Thread->new(\&consumer, $n);
-    $p->join;
-    $c->join;
-    print "$produced $consumed\n";
-}
-
-&main();

data/sources/perl/random.perl-4.perl

@@ -1,17 +0,0 @@
-# The Computer Language Shootout
-# http://shootout.alioth.debian.org/
-# Contributed by Kjetil Skotheim
-
-use constant {IM => 139968, IA => 3877, IC => 29573};
-my $LAST=42;
-
-sub gen_random {
-  my ($n,$max) = @_;
-  use integer;
-  $LAST = ($LAST * IA + IC) % IM for 1..$n;
-  no integer;
-  return $max * $LAST / IM;
-}
-
-printf "%.9f\n", gen_random($ARGV[0] || 1, 100.0);
-

data/sources/perl/recursive.perl-2.perl

@@ -1,57 +0,0 @@
-# The Computer Language Shootout
-# http://shootout.alioth.debian.org/
-# recursive test, by Andreas Koenig, Sep 24 2006
-
-### Uses temp variables to help perl free memory earlier
-
-use strict;
-
-sub Ack
-{
-	my ($x, $y) = @_;
-
-	return $y + 1         if $x == 0;
-	return Ack($x - 1, 1) if $y == 0;
-
-        my $y2 = Ack($x, $y - 1);
-	my $ret = Ack($x - 1, $y2);
-        return $ret;
-}
-
-sub Fib
-{
-	my ($n) = @_;
-
-	return 1 if $n < 2;
-
-        my $f1 = Fib($n - 1);
-        my $f2 = Fib($n - 2);
-	return $f2 + $f1;
-}
-
-sub Tak
-{
-	my ($x, $y, $z) = @_;
-
-        if ($y < $x) {
-          my $z1 = Tak($x - 1.0, $y, $z);
-          my $z2 = Tak($y - 1.0, $z, $x);
-          my $z3 = Tak($z - 1.0, $x, $y);
-          my $ret = Tak($z1, $z2, $z3);
-          return $ret;
-        } else {
-          return $z;
-        }
-}
-
-my $n = ($ARGV[0] || 0) - 1;
-printf "Ack(%d,%d): %d\n",
-	3, $n + 1, Ack(3, $n + 1);
-printf "Fib(%.1f): %.1f\n",
-	28.0 + $n, Fib(28.0 + $n);
-printf "Tak(%d,%d,%d): %d\n",
-	$n * 3, $n * 2, $n, Tak($n * 3, $n * 2, $n);
-printf "Fib(%d): %d\n",
-	3, Fib(3);
-printf "Tak(%.1f,%.1f,%.1f): %.1f\n",
-	3.0,2.0,1.0, Tak(3.0,2.0,1.0);

data/sources/perl/regexdna.perl

@@ -1,48 +0,0 @@
-# The Computer Language Benchmarks Game
-# http://shootout.alioth.debian.org/
-# contributed by Danny Sauer
-# completely rewritten and
-# cleaned up for speed and fun by
-# Mirco Wahab (wahab@chemie.uni-halle.de)
-#
-# Rewritten by
-# Emanuele Zeppieri
-
-use strict;
-
-my $input = do { local $/; <STDIN> };
-my $file_length = length $input;
-
-$input =~ s/^>.*$//mg;
-$input =~ tr/\n//d;
-
-my $seq_length = length $input;
-
-for (
-        'agggtaaa|tttaccct',
-    '[cgt]gggtaaa|tttaccc[acg]',
-    'a[act]ggtaaa|tttacc[agt]t',
-    'ag[act]gtaaa|tttac[agt]ct',
-    'agg[act]taaa|ttta[agt]cct',
-    'aggg[acg]aaa|ttt[cgt]ccct',
-    'agggt[cgt]aa|tt[acg]accct',
-    'agggta[cgt]a|t[acg]taccct',
-    'agggtaa[cgt]|[acg]ttaccct'
-) {
-    my ($r1, $r2) = split /\|/;
-    my $count;
-    $count++ while $input =~ /$r1/gi;
-    $count++ while $input =~ /$r2/gi;
-    print "$_ $count\n"
-}
-
-my %iub = (
-    B => '(c|g|t)', D => '(a|g|t)', H => '(a|c|t)'  ,
-    K => '(g|t)'  , M => '(a|c)'  , N => '(a|c|g|t)',
-    R => '(a|g)'  , S => '(c|g)'  , V => '(a|c|g)'  ,
-    W => '(a|t)'  , Y => '(c|t)'
-);
-my $findiub = '([' . join('', keys %iub) . '])';
-$input =~ s/$findiub/$iub{$1}/og;
-
-printf "\n%d\n%d\n%d\n", $file_length, $seq_length, length $input;

data/sources/perl/regexdna.perl-2.perl

@@ -1,43 +0,0 @@
-# The Computer Language Shootout
-# http://shootout.alioth.debian.org/
-# contributed by Danny Sauer
-# completely rewritten and
-# cleaned up for speed and fun by
-# Mirco Wahab (wahab@chemie.uni-halle.de)
-
-use strict;
-use warnings;
-use re 'eval';
-
-my $content =  do { local $/; <STDIN> };
-my $l_file  =  length $content;
-my $dispose =  qr/^>.*$|\n/m;
-   $content =~ s/$dispose//g;
-my $l_code  =  length $content;
-
-my @seq = ( 'agggtaaa|tttaccct',
-        '[cgt]gggtaaa|tttaccc[acg]',
-        'a[act]ggtaaa|tttacc[agt]t',
-        'ag[act]gtaaa|tttac[agt]ct',
-        'agg[act]taaa|ttta[agt]cct',
-        'aggg[acg]aaa|ttt[cgt]ccct',
-        'agggt[cgt]aa|tt[acg]accct',
-        'agggta[cgt]a|t[acg]taccct',
-        'agggtaa[cgt]|[acg]ttaccct' );
-
-my @cnt = (0) x @seq;
-for my $k (0..$#seq) {
-  ++$cnt[$k] while $content=~/$seq[$k]/gi;
-  printf "$seq[$k] $cnt[$k]\n"
-}
-
-my %iub = (         B => '(c|g|t)',  D => '(a|g|t)',
-  H => '(a|c|t)',   K => '(g|t)',    M => '(a|c)',
-  N => '(a|c|g|t)', R => '(a|g)',    S => '(c|g)',
-  V => '(a|c|g)',   W => '(a|t)',    Y => '(c|t)' );
-
-my $findiub = '(['.(join '', keys %iub).'])';
-
-1 while $content =~ s/$findiub/$iub{$1}/og;
-printf "\n%d\n%d\n%d\n", $l_file, $l_code, length $content;
-

data/sources/perl/regexdna.perl-3.perl

@@ -1,50 +0,0 @@
-# The Computer Language Shootout
-# http://shootout.alioth.debian.org/
-# contributed by Danny Sauer
-# completely rewritten and
-# cleaned up for speed and fun by
-# Mirco Wahab (wahab@chemie.uni-halle.de)
-#
-# Rewritten for speed sextuplication by
-# Emanuele Zeppieri
-
-use strict;
-
-my $input = do { local $/; <STDIN> };
-my $file_length = length $input;
-
-$input =~ s/^>.*$//mg;
-$input =~ tr/\n//d;
-
-my $seq_length = length $input;
-
-my $input_lc = lc $input;
-
-for (
-        'agggtaaa|tttaccct',
-    '[cgt]gggtaaa|tttaccc[acg]',
-    'a[act]ggtaaa|tttacc[agt]t',
-    'ag[act]gtaaa|tttac[agt]ct',
-    'agg[act]taaa|ttta[agt]cct',
-    'aggg[acg]aaa|ttt[cgt]ccct',
-    'agggt[cgt]aa|tt[acg]accct',
-    'agggta[cgt]a|t[acg]taccct',
-    'agggtaa[cgt]|[acg]ttaccct'
-) {
-    my ($r1, $r2) = split /\|/;
-    my $count;
-    $count++ while $input_lc =~ /$r1/g;
-    $count++ while $input_lc =~ /$r2/g;
-    print "$_ $count\n"
-}
-
-my %iub = (
-    B => '(c|g|t)', D => '(a|g|t)', H => '(a|c|t)'  ,
-    K => '(g|t)'  , M => '(a|c)'  , N => '(a|c|g|t)',
-    R => '(a|g)'  , S => '(c|g)'  , V => '(a|c|g)'  ,
-    W => '(a|t)'  , Y => '(c|t)'
-);
-my $findiub = '([' . join('', keys %iub) . '])';
-$input =~ s/$findiub/$iub{$1}/og;
-
-printf "\n%d\n%d\n%d\n", $file_length, $seq_length, length $input;

data/sources/perl/regexdna.perl-4.perl

@@ -1,49 +0,0 @@
-# The Computer Language Benchmarks Game
-# http://shootout.alioth.debian.org/
-# contributed by Danny Sauer
-# completely rewritten and
-# cleaned up for speed and fun by Mirco Wahab
-# improved STDIN read, regex clean up by Jake Berner
-
-use strict;
-use warnings;
-
-my $l_file  = -s STDIN;
-my $content; read STDIN, $content, $l_file;
-# this is significantly faster than using <> in this case
-
-my $dispose =  qr/(^>.*)?\n/m; # slight performance gain here
-   $content =~ s/$dispose//g;
-my $l_code  =  length $content;
-
-my @seq = ( 'agggtaaa|tttaccct',
-        '[cgt]gggtaaa|tttaccc[acg]',
-        'a[act]ggtaaa|tttacc[agt]t',
-        'ag[act]gtaaa|tttac[agt]ct',
-        'agg[act]taaa|ttta[agt]cct',
-        'aggg[acg]aaa|ttt[cgt]ccct',
-        'agggt[cgt]aa|tt[acg]accct',
-        'agggta[cgt]a|t[acg]taccct',
-        'agggtaa[cgt]|[acg]ttaccct' );
-
-my @cnt = (0) x @seq;
-for my $k (0..$#seq) {
-  ++$cnt[$k] while $content=~/$seq[$k]/gi;
-  printf "$seq[$k] $cnt[$k]\n"
-}
-
-my %iub = (         B => '(c|g|t)',  D => '(a|g|t)',
-  H => '(a|c|t)',   K => '(g|t)',    M => '(a|c)',
-  N => '(a|c|g|t)', R => '(a|g)',    S => '(c|g)',
-  V => '(a|c|g)',   W => '(a|t)',    Y => '(c|t)' );
-
-# using $& and no submatch marginally improves the
-# speed here, but mentioning $& causes perl to 
-# define that value for the @seq patterns too, which
-# slows those down considerably. No change.
-
-my $findiub = '(['.(join '', keys %iub).'])';
-
-$content =~ s/$findiub/$iub{$1}/g;
-
-printf "\n%d\n%d\n%d\n", $l_file, $l_code, length $content;

data/sources/perl/regexdna.perl-5.perl

@@ -1,42 +0,0 @@
-# The Computer Language Benchmarks Game
-# http://shootout.alioth.debian.org/
-# contributed by Danny Sauer
-# modified by Mirco Wahab
-# Sped up by 2^2 in 2007 by Steffen Mueller
-
-use strict;
-use warnings;
-
-my $content =  do { local $/; <STDIN> };
-my $l_file  =  length $content;
-my $dispose =  qr/^>.*$|\n/m;
-   $content =~ s/$dispose//g;
-my $l_code  =  length $content;
-
-my @seq = ( 'agggtaaa|tttaccct',
-        '[cgt]gggtaaa|tttaccc[acg]',
-        'a[act]ggtaaa|tttacc[agt]t',
-        'ag[act]gtaaa|tttac[agt]ct',
-        'agg[act]taaa|ttta[agt]cct',
-        'aggg[acg]aaa|ttt[cgt]ccct',
-        'agggt[cgt]aa|tt[acg]accct',
-        'agggta[cgt]a|t[acg]taccct',
-        'agggtaa[cgt]|[acg]ttaccct' );
-
-my @cnt = (0) x @seq;
-for (0..$#seq) {
-  my ($l, $r) = map {qr/$_/} split /\|/, $seq[$_];
-  $cnt[$_] += (() = ($content=~/$l/gi, $content=~/$r/gi));
-  print $seq[$_], ' ', $cnt[$_], "\n";
-}
-
-my %iub = (         B => '(c|g|t)',  D => '(a|g|t)',
-  H => '(a|c|t)',   K => '(g|t)',    M => '(a|c)',
-  N => '(a|c|g|t)', R => '(a|g)',    S => '(c|g)',
-  V => '(a|c|g)',   W => '(a|t)',    Y => '(c|t)' );
-
-my $findiub = '(['.(join '', keys %iub).'])';
-
-$content =~ s/$findiub/$iub{$1}/g;
-print "\n", $l_file, "\n", $l_code, "\n", length($content), "\n";
-