[Shootout-list] perl revcomp

bradford powell bradford powell <bradford.powell@gmail.com>
Wed, 23 Mar 2005 14:01:01 -0500


Here's a perl revcomp, very similar to the python revcomp I submitted
recently. It could probably be written more concisely, but it gets the
point across.


--- cut here
#!/usr/bin/perl
#
# Contributed by Bradford Powell
#

use strict;

sub print_revcomp {
        my ($desc, $s) = @_;
        print $desc, "\n";
        $s =~ tr/wsatugcyrkmbdhvnATUGCYRKMBDHVN/WSTAACGRYMKVHDBNTAACGRYMKVHDBN/;
        $s = reverse $s;
        while ($s) {
                print substr($s, 0, 60), "\n";
                $s = substr($s, 60);
        }
}

my ($desc, $seq) = ('', '');
while (<>) {
        chomp;
        if (/^>/) {
                if ($desc) {
                        print_revcomp($desc, $seq);
                        $seq = '';
                }
                $desc = $_;
        } else {
                $seq .= $_;
        }
}
if ($desc) {
        print_revcomp($desc, $seq);
}