Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hi fellow Monks!
I would like to ask you to help me write the following code in a more "sophisticated" way.
What the code does is, given to strings of characters, like the following 
$string1 = "IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
+IIIIIIIIIIMMMMMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIIMMMMMMMMMMM
+MMOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIMMMMMMMMMMMOOOOOOOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMIIIIIMMMMMMMM
+MMMOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIMMMMMMMMMOOOOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMIIIMMMMMMMMMOOOOOOOOOOOOOOOOOOOMMM
+MMMMMMIIIIIIIIIIIIIIIIIIIIIIIIIIIMMMMMMMMOMMMMMMMMMMMMM";

$string2 = "IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
+IIIIIIIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMMIIIIIMMMMMMMMMM
+MMMOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMIIIMMMMMMMMMMMMMMOOOOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMIIIMMMMMMMMMM
+MMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMIIIMMMMMMMMMMMMMMMOOOO
+OOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOMMMM
+MMMMMMIIIIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOOOMMMMMMMMMMMMII";

[download]

the program should check the following:
1. Do both strings start with the same character? (in this case yes, they do)
2. Do both strings contain the same number of M substrings? (In this case yes, because both have 13).
3.Do each pair of the M substrings overlap for at least 5 positions (we would compare the 1st M substring of the first string to the 1st M substring of the seecond string and so on).
My code is the following, please bear with me because I am kind of new in Perl:
#N-terminal
$Nterm_topo=substr($string2,0,1);
$Nterm_pred=substr($string1,0,1);

#TM number and orientation for $string2
$TM_topo=0;
$all_tms='';
while($string2=~/M+/g)
{
$TM_topo++;
$start_tm=$-[0]; 
$end_tm=$+[0]-1;
                $all_tms.=$start_tm."-".$end_tm."#";
}
chop $all_tms;

#TM number and orientation for $string1
$TM_pred=0;
while($string1=~/(M+)/g) { $TM_pred++; }    

################ Orientation ############################
$correct_TM_location=0;
@split_tms_real=split(/#/, $all_tms);

for ($i=0;$i<=$#split_tms_real;$i++)
{
$corresp_TM_real=$split_tms_real[$i];
if($corresp_TM_real=~/(\d+)\-(\d+)/) 
  { 
     $start_real=$1; $end_real=$2;
     $real_length=$end_real-$start_real+1;
     $substr_pred=substr($string1,$start_real, $real_length);
                    $count_M=$substr_pred=~tr/M//;

if($count_M>=5) {$correct_TM_location++;}
                }                    
}                

if( $Nterm_topo eq $Nterm_pred  $TM_topo==$TM_pred && $TM_pred==$corre
+ct_TM_location) 
{
   $correct_topo++; 
}

[download]

Replies are listed 'Best First'.
Re: Can you help me re-write this code?
by toolic (Bishop) on Aug 11, 2015 at 14:10 UTC
    2. Do both strings contain the same number of M substrings? (In this case yes, because both have 13).
    I count 14 for both: 
    use warnings;
use strict;

my $string1 = "IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
+IIIIIIIIIIIIIMMMMMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIIMMMMMMMM
+MMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIMMMMMMMMMMMOOOOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMIIIIIMMMMM
+MMMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIMMMMMMMMMOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMIIIMMMMMMMMMOOOOOOOOOOOOOOOOOOO
+MMMMMMMMMIIIIIIIIIIIIIIIIIIIIIIIIIIIMMMMMMMMOMMMMMMMMMMMMM";
my $string2 = "IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
+IIIIIIIIIIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMMIIIIIMMMMMMM
+MMMMMMOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMIIIMMMMMMMMMMMMMMOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMIIIMMMMMMM
+MMMMMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMIIIMMMMMMMMMMMMMMMO
+OOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOM
+MMMMMMMMMIIIIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOOOMMMMMMMMMMMMII";

print mgroups($string1), "\n";
print mgroups($string2), "\n";

sub mgroups {
    my $str = shift;
    my $cnt = 0;
    while ($str =~ /M+/g) {
        $cnt++;
    }
    return $cnt;
}

__END__

14
14

    [download]
[reply]
[d/l]
Re: Can you help me re-write this code?
by kennethk (Abbot) on Aug 11, 2015 at 14:48 UTC
    I note that the code doesn't actually run because line 39 is not valid Perl. I also note that there is no effect other than caching the correctness of the string in $correct_topo, so there are probably some real wins to be had by broader restructuring (using subroutines and modules, early exits, Loop Control, structuring data, ...).

    Why are you caching a bunch of temporary variables rather than actually performing each test in sequence? It would seem much more logical to check if your substr expressions are equal, rather than creating two variables with cryptic names. You also do a lot with regular expressions that is probably excessive.

    The most basic recommendation is to use strict and warnings -- see Use strict warnings and diagnostics or die for a discussion of why.

    You could also get a lot of traction from the index command if you actually know what letter you are looking for. 

    #!/usr/bin/perl
use strict;
use warnings;

my $string1 = "IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
+IIIIIIIIIIIIIMMMMMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIIMMMMMMMM
+MMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIMMMMMMMMMMMOOOOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMIIIIIMMMMM
+MMMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIMMMMMMMMMOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMIIIMMMMMMMMMOOOOOOOOOOOOOOOOOOO
+MMMMMMMMMIIIIIIIIIIIIIIIIIIIIIIIIIIIMMMMMMMMOMMMMMMMMMMMMM";
my $string2 = "IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
+IIIIIIIIIIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMMIIIIIMMMMMMM
+MMMMMMOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMIIIMMMMMMMMMMMMMMOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMIIIMMMMMMM
+MMMMMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMIIIMMMMMMMMMMMMMMMO
+OOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOM
+MMMMMMMMMIIIIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOOOMMMMMMMMMMMMII";

my $correct_topo = 1;

# Test if they start with the same letter
if (substr($string1,0,1) ne substr($string2,0,1)) {
   undef $correct_topo;  
}

# Test if M counts match up
my $count1;
$count1++ while $string1 =~ /M+/g;
my $count2;
$count2++ while $string2 =~ /M+/g;
if ($count1 != $count2) {
    undef $correct_topo;
}

# Test if M's line up
my $start = index($string1, 'M');
$start = index($string2, 'M', $start); # In case it starts later
while ($start != -1) { # While I haven't missed anything
    $count1--; # See of the counts line up, in case we skip collisions
    if (    substr($string1,$start,5) ne 'MMMMM'
        or  substr($string2,$start,5) ne 'MMMMM')
    {
        undef $correct_topo;
        last;
    }
    substr($string1,$start) =~ /[^M]/ or last; # Ran out of string
    $start = index $string1, 'M', $-[0]+$start; # Start of next set of
+ M's
    $start = index $string2, 'M', $start if $start != -1; # But this c
+hunk might start later
}

undef $correct_topo if $count1 != 0;

    [download]

    #11929 First ask yourself `How would I do this without a computer?' Then have the computer do it the same way.

[reply]
[d/l]
[select]
Re: Can you help me re-write this code?
by ikegami (Patriarch) on Aug 11, 2015 at 15:14 UTC 
    1. substr($s1, 0, 1) eq substr($s2, 0, 1)

      [download]
    2. ( () = $s1 =~ /(M+)/ ) == ( () = $s2 =~ /(M+)/ )

      [download]
    3. ( my $s1_ = $s1 ) =~ tr/M/\1/c;
( my $s2_ = $s2 ) =~ tr/M/\2/c;
( ( $s1_ ^ $s2_ ) =~ tr/\0// ) >= 5

      [download]

    Update: Nevermind. I misread #3.

[reply]
[d/l]
[select]
Re: Can you help me re-write this code?
by Anonymous Monk on Aug 11, 2015 at 17:00 UTC 
    #!/usr/bin/perl

# http://perlmonks.org/?node_id=1138167

use strict;
use warnings;

my $string1 = "IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
+IIIIIIIIIIIIIMMMMMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIIMMMMMMMM
+MMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIMMMMMMMMMMMOOOOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMIIIIIMMMMM
+MMMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMIIIMMMMMMMMMOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMIIIMMMMMMMMMOOOOOOOOOOOOOOOOOOO
+MMMMMMMMMIIIIIIIIIIIIIIIIIIIIIIIIIIIMMMMMMMMOMMMMMMMMMMMMM";

my $string2 = "IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
+IIIIIIIIIIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMMIIIIIMMMMMMM
+MMMMMMOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMIIIMMMMMMMMMMMMMMOOOOOOO
+OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMMIIIMMMMMMM
+MMMMMMMMOOOOOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMIIIMMMMMMMMMMMMMMMO
+OOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMMMMMMMIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOM
+MMMMMMMMMIIIIIIMMMMMMMMMMMMOOOOOOOOOOOOOOOOOMMMMMMMMMMMMII";

my $same = ($string1 ^ $string2) =~ /^\0/ ? 'SAME' : 'DIFFERENT';

my ($count1, $count2) = map scalar(() = /M+/g), $string1, $string2;

my $overlap5 = 0;
$overlap5 += substr($string2, $-[0], length $1) =~ /M{5}/
  while $string1 =~ /(M+)/g;

print "first letter $same,  M counts $count1 $count2,  overlap5 $overl
+ap5\n";

    [download]
[reply]
[d/l]
      Many thanks to all of you, it is very nice to read up on suggestions!
[reply]

Back to Seekers of Perl Wisdom