6/ire.pl


#!/usr/bin/perl -w

use strict;

my $seq = 'GAGAGCAGUGGGGGUUUCCUGCUUCAACAGUGCUUGGACGGAACCCGGCGCUCGUU';

for ( my $i = 0 ; $i < length($seq) - 15 ; $i++ ) {
    my $test = substr( $seq, $i, 16 );
    if ( substr( $test, 5, 5 ) eq 'CAGUG' ) {
        my $strand1 = substr( $test, 0,  5 );
        my $strand2 = substr( $test, 11, 5 );
        if ( findstem( $strand1, $strand2 ) ) {
            my $pos = $i + 1;
            print "match at position $pos:\n";
            print "$test\n";
            print "<----CAGUGN---->\n";
        }
    }    
}    

sub findstem {
    my $tag = 1;
    my ( $strand1, $strand2 ) = @_;
    for ( my $j = 0 ; $j < 5 ; $j++ ) {
        my $base1 = substr( $strand1, $j,     1 );
        my $base2 = substr( $strand2, 4 - $j, 1 );
        if ( pair( $base1, $base2 ) == 0 ) { $tag = 0; }
    }
    if ($tag) { return 1; }
}

sub pair {
    my ( $base1, $base2 ) = @_;
    if (   ( ( $base1 eq 'G' ) && ( $base2 eq 'C' ) )
        || ( ( $base1 eq 'G' ) && ( $base2 eq 'U' ) )
        || ( ( $base1 eq 'A' ) && ( $base2 eq 'U' ) )
        || ( ( $base1 eq 'C' ) && ( $base2 eq 'G' ) )
        || ( ( $base1 eq 'U' ) && ( $base2 eq 'A' ) )
        || ( ( $base1 eq 'U' ) && ( $base2 eq 'G' ) ) )
    {
        return 1;
    }
}