chrislo-sourceclassifier 0.2.0 → 0.2.1

data/sources/perl/regexdna.perl-6.perl

@@ -1,43 +0,0 @@
-# The Computer Language Benchmarks Game
-# http://shootout.alioth.debian.org/
-# contributed by Danny Sauer
-# modified by Mirco Wahab
-# modified by Steffen Mueller
-# modified by Kuang-che Wu
-
-use strict;
-use warnings;
-
-my $content =  do { local $/; <STDIN> };
-my $l_file  =  length $content;
-$content =~ s/^>.*$//mg;
-$content =~ s/\n//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";
-

data/sources/perl/regexmatch.perl

@@ -1,35 +0,0 @@
-#!/usr/bin/perl 
-# $Id: regexmatch.perl,v 1.1.1.1 2004-05-19 18:11:25 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-
-use strict;
-
-my $re = qr{
-    (?: ^ | [^\d\(])		# must be preceeded by non-digit
-    ( \( )?			# match 1: possible initial left paren
-    (\d\d\d)			# match 2: area code is 3 digits
-    (?(1) \) )			# if match1 then match right paren
-    [ ]				# area code followed by one space
-    (\d\d\d)			# match 3: prefix of 3 digits
-    [ -]			# separator is either space or dash
-    (\d\d\d\d)			# match 4: last 4 digits
-    \D				# must be followed by a non-digit
-}x;
-
-my $NUM = $ARGV[0];
-$NUM = 1 if ($NUM < 1);
-
-my @phones = <STDIN>;
-my $count = 0;
-my $num;
-while ($NUM--) {
-    foreach (@phones) {
-	if (/$re/o) {
-	    $num = "($2) $3-$4";
-	    if (0 == $NUM) {
-		$count++;
-		print "$count: $num\n";
-	    }
-	}
-    }
-}

data/sources/perl/revcomp.perl-2.perl

@@ -1,34 +0,0 @@
-#!/usr/bin/perl
-
-# The Great Computer Language Shootout
-# http://shootout.alioth.debian.org/
-#
-# Contributed by Bradford Powell
-# Fixed slow print substr-solution, by Kjetil Skotheim
-
-
-use strict;
-
-sub print_revcomp {
-    my ($desc, $s) = @_;
-    return if not $desc;
-    print $desc, "\n";
-    $s =  reverse $s;
-    $s =~ tr{wsatugcyrkmbdhvnATUGCYRKMBDHVN}
-            {WSTAACGRYMKVHDBNTAACGRYMKVHDBN};
-    my($i,$stop)=(0,length($s)/60);
-    print substr($s,$i++*60,60),"\n"  while $i<$stop;
-}
-
-my($desc,$seq);
-while (<STDIN>) {
-    chomp;
-    if (/^>/) {
-        print_revcomp($desc, $seq);
-        $desc = $_;
-        $seq = '';
-    } else {
-        $seq .= $_;
-    }
-}
-print_revcomp($desc, $seq);

data/sources/perl/reversefile.perl

@@ -1,8 +0,0 @@
-#!/usr/bin/perl
-# $Id: reversefile.perl,v 1.2 2004-11-23 08:08:45 bfulgham Exp $
-# http://shootout.alioth.debian.org/
-# Revised by Soren Morton
-
-undef($/);
-print reverse( split(/^/, <STDIN>));
-#print join("\n", reverse split(/\n/, <STDIN>)),"\n";

data/sources/perl/sieve.perl

@@ -1,23 +0,0 @@
-#!/usr/bin/perl 
-# $Id: sieve.perl,v 1.1.1.1 2004-05-19 18:12:27 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-# with help from Tony Bowden
-
-use strict;
-use integer;
-
-my $NUM = ($ARGV[0] < 1) ? 1 : $ARGV[0];
-my $count;
-my @flags = ();
-while ($NUM--) {
-    $count = 0; 
-    my @flags = (0 .. 8192);
-    for my $i (2 .. 8192 ) {
-	next unless defined $flags[$i];
-	# remove all multiples of prime: i
-	my $k = $i;
-	undef $flags[$k] while (($k+=$i) < 8193);
-	$count++;
-    }
-}
-print "Count: $count\n";

data/sources/perl/spectralnorm.perl-2.perl

@@ -1,54 +0,0 @@
-# The Computer Language Shootout
-# http://shootout.alioth.debian.org/
-#
-# Contributed by Markus Peter
-
-sub A {
-    my ( $i, $j ) = @_;
-    return 1.0 / ( ( $i + $j ) * ( $i + $j + 1 ) / 2 + $i + 1 );
-}
-
-sub Av {
-    my ( $u ) = @_;
-    my $len= $#$u;
-    my @v= ();
-    for my $i ( 0..$len ) {
-        $v[$i] = 0;
-        for my $j ( 0..$len ) { $v[$i] += A( $i, $j ) * $u->[$j]; }
-    }
-    return \@v;
-}
-
-sub Atv {
-    my ( $u ) = @_;
-    my $len= $#$u;
-    my @v= ();
-    for my $i ( 0..$len ) {
-        $v[$i] = 0;
-        for my $j ( 0..$len ) { $v[$i] += A( $j, $i ) * $u->[$j]; }
-    }
-    return \@v;
-}
-
-sub AtAv {
-    my ( $u ) = @_;
-    return Atv(Av($u));
-}
-
-my $i;
-my $N = @ARGV ? $ARGV[0] : 500;
-
-my $v;
-my $u= [];
-for $i (0..$N-1) { $u->[$i]=1; }
-for $i (0..9) {
-    $v= AtAv( $u);
-    $u= AtAv( $v);
-}
-
-$vBv = $vv = 0;
-for $i (0..$N-1) {
-    $vBv += $u->[$i] * $v->[$i];
-    $vv += $v->[$i] * $v->[$i];
-}
-printf( "%0.9f\n", sqrt( $vBv / $vv ) );

data/sources/perl/spellcheck.perl

@@ -1,24 +0,0 @@
-#!/usr/bin/perl
-# $Id: spellcheck.perl,v 1.2 2004-07-31 09:19:06 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-# 
-# Updated per suggestions by Alan Post
-
-use strict;
-
-# read dictionary
-open(DICT, "<Usr.Dict.Words") or
-    die "Error, unable to open Usr.Dict.Words\n";
-
-my %dict;
-while (<DICT>) {
-    chomp;
-    $dict{$_} = undef;
-}
-close(DICT);
-
-$\ = "\n";
-while (<STDIN>) {
-    chomp;
-    print unless exists $dict{$_};
-}

data/sources/perl/strcat.perl

@@ -1,13 +0,0 @@
-#!/usr/bin/perl 
-# $Id: strcat.perl,v 1.1.1.1 2004-05-19 18:13:35 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-
-use strict;
-
-my $NUM = $ARGV[0];
-$NUM = 1 if ($NUM < 1);
-
-my $str = "";
-$str .= "hello\n" foreach (1..$NUM);
-print length($str),"\n";
-

data/sources/perl/sumcol.perl

@@ -1,8 +0,0 @@
-#!/usr/bin/perl
-# $Id: sumcol.perl,v 1.1.1.1 2004-05-19 18:13:44 bfulgham Exp $
-# http://www.bagley.org/~doug/shootout/
-
-use integer;
-shift;
-while (<>) { $tot += $_ }
-print "$tot\n";

data/sources/perl/takfp.perl

@@ -1,23 +0,0 @@
-#!/usr/bin/perl -w 
-# http://shootout.alioth.debian.org
-# 
-# Perl dies from lack of memory while computing the recursive
-# tak function.  So here's a version that can compute the benchmark
-# in constant time.
-#
-# by Greg Buchholz
-
-
-$n=shift;
-printf "%.1f\n", tak($n);
-
-sub tak
-{   
-    my $z=shift;
-
-    return $z   if($z<0);
-    return 2*$z if(int($z)==$z && $z%2);
-    return $z+1 if(int($z)==$z && !($z%2));
-    return 2*$z if(!(int($z)%2));
-    return int($z)+2*($z-int($z));
-}

data/sources/perl/takfp.perl-3.perl

@@ -1,20 +0,0 @@
-#!/usr/bin/perl
-# The Computer Language Shootout
-# http://shootout.alioth.debian.org/
-# by Greg Buchholz
-# memory consumption fixed by Danny Sauer
-
-my $n = $ARGV[0];
-sub takfp($$$);
-
-printf "%.1f\n", takfp(3*$n, 2*$n, $n);
-
-sub takfp($$$)
-{
-   return ($_[1] >= $_[0]) ? 
-           $_[2] : 
-           takfp( takfp($_[0]-1.0, $_[1], $_[2]),
-                  takfp($_[1]-1.0, $_[2], $_[0]),
-                  takfp($_[2]-1.0, $_[0], $_[1])
-              )
-}

data/sources/perl/tcpecho.perl

@@ -1,61 +0,0 @@
-#!/usr/bin/perl
-
-# The Great Computer Language Shootout
-#  http://shootout.alioth.debian.org/
-#
-#   contributed by John O'Hare 03 August 2005.
-
-use strict;
-use warnings;
-use Socket;
-
-use constant PORT_NUMBER => 	12330;
-use constant M => 		6400;
-use constant REPLY_SIZE => 	64;
-use constant REQUEST_SIZE => 	64;
-
-my $n = 1;
-$n = $ARGV[0] if (defined($ARGV[0]));
-$n *= M;
-
-unless (fork) { #client
-	sleep 2; #wait for the server to start
-
-	my $cbuf;
-	my $request = chr(60)x REQUEST_SIZE;
-	my $bytes = 0;
-	my $replies = 0;
-
-	socket(CSOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die $!;
-	connect(CSOCK, sockaddr_in(PORT_NUMBER, INADDR_LOOPBACK)) or die $!;
-
-	while ($n--) {
-		my $tmpbytes = 0;
-		defined(send(CSOCK, $request, 0)) or die $!;
-		while (($tmpbytes += sysread(CSOCK, $cbuf, REPLY_SIZE)) < REPLY_SIZE) {}
-		$bytes += $tmpbytes;
-		$replies++;
-	}
-
-	shutdown(CSOCK, 2);
-	print "replies: $replies\tbytes: $bytes\n";
-	exit(0);
-}
-
-#server
-my $reply = chr(62)x REPLY_SIZE;
-my $sbuf;
-
-socket(SSOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die $!;
-bind (SSOCK, sockaddr_in(PORT_NUMBER, INADDR_LOOPBACK)) || die $!;
-
-listen (SSOCK, 1);
-
-accept (CONN, SSOCK) || die $!;
-
-while (sysread(CONN, $sbuf, REQUEST_SIZE)) {
-	defined(send(CONN, $reply, 0)) or die $!;
-}
-
-shutdown(CONN, 2);
-shutdown(SSOCK, 2);

data/sources/perl/tcprequest.perl

@@ -1,61 +0,0 @@
-#!/usr/bin/perl
-
-# The Great Computer Language Shootout
-#  http://shootout.alioth.debian.org/
-#
-#   contributed by John O'Hare 03 August 2005.
-
-use strict;
-use warnings;
-use Socket;
-
-use constant PORT_NUMBER => 	12331;
-use constant M => 		100;
-use constant REPLY_SIZE => 	4096;
-use constant REQUEST_SIZE => 	64;
-
-my $n = 1;
-$n = $ARGV[0] if (defined($ARGV[0]));
-$n *= M;
-
-unless (fork) { #client
-	sleep 2; #wait for the server to start
-
-	my $cbuf;
-	my $request = chr(60)x REQUEST_SIZE;
-	my $bytes = 0;
-	my $replies = 0;
-
-	socket(CSOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die $!;
-	connect(CSOCK, sockaddr_in(PORT_NUMBER, INADDR_LOOPBACK)) or die $!;
-
-	while ($n--) {
-		my $tmpbytes = 0;
-		defined(send(CSOCK, $request, 0)) or die $!;
-		while (($tmpbytes += sysread(CSOCK, $cbuf, REPLY_SIZE)) < REPLY_SIZE) {}
-		$bytes += $tmpbytes;
-		$replies++;
-	}
-
-	shutdown(CSOCK, 2);
-	print "replies: $replies\tbytes: $bytes\n";
-	exit(0);
-}
-
-#server
-my $reply = chr(62)x REPLY_SIZE;
-my $sbuf;
-
-socket(SSOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die $!;
-bind (SSOCK, sockaddr_in(PORT_NUMBER, INADDR_LOOPBACK)) || die $!;
-
-listen (SSOCK, 1);
-
-accept (CONN, SSOCK) || die $!;
-
-while (sysread(CONN, $sbuf, REQUEST_SIZE)) {
-	defined(send(CONN, $reply, 0)) or die $!;
-}
-
-shutdown(CONN, 2);
-shutdown(SSOCK, 2);

data/sources/perl/tcpstream.perl

@@ -1,61 +0,0 @@
-#!/usr/bin/perl
-
-# The Great Computer Language Shootout
-#  http://shootout.alioth.debian.org/
-#
-#   contributed by John O'Hare 03 August 2005.
-
-use strict;
-use warnings;
-use Socket;
-
-use constant PORT_NUMBER => 	12332;
-use constant M => 		1;
-use constant REPLY_SIZE => 	409600;
-use constant REQUEST_SIZE => 	64;
-
-my $n = 1;
-$n = $ARGV[0] if (defined($ARGV[0]));
-$n *= M;
-
-unless (fork) { #client
-	sleep 2; #wait for the server to start
-
-	my $cbuf;
-	my $request = chr(60)x REQUEST_SIZE;
-	my $bytes = 0;
-	my $replies = 0;
-
-	socket(CSOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die $!;
-	connect(CSOCK, sockaddr_in(PORT_NUMBER, INADDR_LOOPBACK)) or die $!;
-
-	while ($n--) {
-		my $tmpbytes = 0;
-		defined(send(CSOCK, $request, 0)) or die $!;
-		while (($tmpbytes += sysread(CSOCK, $cbuf, REPLY_SIZE)) < REPLY_SIZE) {}
-		$bytes += $tmpbytes;
-		$replies++;
-	}
-
-	shutdown(CSOCK, 2);
-	print "replies: $replies\tbytes: $bytes\n";
-	exit(0);
-}
-
-#server
-my $reply = chr(62)x REPLY_SIZE;
-my $sbuf;
-
-socket(SSOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die $!;
-bind (SSOCK, sockaddr_in(PORT_NUMBER, INADDR_LOOPBACK)) || die $!;
-
-listen (SSOCK, 1);
-
-accept (CONN, SSOCK) || die $!;
-
-while (sysread(CONN, $sbuf, REQUEST_SIZE)) {
-	defined(send(CONN, $reply, 0)) or die $!;
-}
-
-shutdown(CONN, 2);
-shutdown(SSOCK, 2);