chrislo-sourceclassifier 0.2.0

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

@@ -0,0 +1,43 @@
+# 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

@@ -0,0 +1,35 @@
+#!/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

@@ -0,0 +1,34 @@
+#!/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

@@ -0,0 +1,8 @@
+#!/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

@@ -0,0 +1,23 @@
+#!/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

@@ -0,0 +1,54 @@
+# 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

@@ -0,0 +1,24 @@
+#!/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

@@ -0,0 +1,13 @@
+#!/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

@@ -0,0 +1,8 @@
+#!/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

@@ -0,0 +1,23 @@
+#!/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

@@ -0,0 +1,20 @@
+#!/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

@@ -0,0 +1,61 @@
+#!/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

@@ -0,0 +1,61 @@
+#!/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

@@ -0,0 +1,61 @@
+#!/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);