Krithi.S
Krithi.S

Reputation: 55

How to finding intervals based on matching elements in perl.?

@t = qw(a b c d e + g h + j k m n l + h +);
@q = qw(a b c d e f g h i j k l m l j h h);
@s = qw(a b c d e f g h k j k l m l j h h);

foreach (0..$#q){

  if($t[$_] eq ($q[$_] && $s[$_])){
   print "$t[$_]";
   }
print "$t[$_]-$t[$_]\n";

   elsif($t[$_] eq '+' && $q[$_] eq $s[$_]){
    print"$t[$_]";
   }
   else{
   print "\n";
   }
  }

Expected Output:

abcde+gh  [1-8]
jk        [10-11]

l+h+      [14-17]

Here @t based on matching both @q and @s, and print the intervals also based on @t. I am not able to get an intervals as mismatching. please give me a good solution

Upvotes: 0

Views: 117

Answers (2)

Patrick J. S.
Patrick J. S.

Reputation: 2935

Your code has an syntax error you introduced with your 4th edit. You can't put any code outside an if's block and its elseif. If I understood it right you wanted to know when the arrays @q, @s and @t line up, where @t is allowed to have '+' as a wildcard.

Here is one solution. It uses a $start variable to check if we are inside an interval and stores the beginning. If we are at the end of an interval or the arrays. We print the interval lengths. There are probably nicer ways to format this. The best would be to introduce more complex ad-hoc objects. The code would be much easier if you were't interested in the indices of the beginning and end of the intervals.

For the test: I restructured it a bit. Furthermore if you already know that $q[$_] eq $s[$_] you won't have to check both $t[$_] eq $s[$_] and $t[$_] eq $q[$_]. You don't have to make that check at all if $t[$_] eq "+"

#!/usr/bin/env perl

use strict;   # These aren't optional!
use warnings; # Always use them!
use 5.01;     # for the // operator and say

my @t = qw(a b c d e + g h + j k m n l + h +);
my @q = qw(a b c d e f g h i j k l m l j h h);
my @s = qw(a b c d e f g h k j k l m l j h h);

my ($start);
sub print_interval{
  my $end = shift;
  printf((' 'x(8+$start-$end)). # inserting the whitespaces
     "[%2d-%-2d]\n", $start, $end);
}

foreach (0..$#q){
  my ($te, $qe, $se) = ($t[$_], $q[$_], $s[$_]); # just shorthands
  if($qe eq $se && ($te eq "+" || $te eq $qe)){
    $start //= $_; # if not set, set it to the current index
    print $te;
  }elsif (defined $start){
    print_interval($_-1);
    undef $start;
  }
}

if (defined $start){
  # if we are still in an interval at the end,
  #  we'll have to print that too.
  print_interval($#q)
}

If you're uncomfortable with the definedness checks, you also can set $start to -1 and check 0 <= $start.

Here is a solution that uses intermediate objects and saves the results in an array, this makes for nicer formatting and the code is structured better:

# … strict, warnings, array declarations
my ($res,@results);

foreach (0..$#q){
  my ($te, $qe, $se) = ($t[$_], $q[$_], $s[$_]);
  if($qe eq $se && ($te eq "+" || $te eq $qe)){
    $res = {start => $_, string => ''} unless defined $res;
    $res->{string} .= $te;
  }elsif (defined $res){
    $res->{end} = $_-1;
    push @results, $res;
    undef $res;
  }
}
if (defined $res){ # still in interval
  $res->{end} = $#q;
  push @results, $res;
}

printf "%-9s[%2d-%-2d]\n", @{$_}{qw|string start end|} for @results;

Upvotes: 1

Tim Hallyburton
Tim Hallyburton

Reputation: 2929

#!/usr/bin/perl

use strict;
use warnings;

my @t = qw(a b c d e + g h + j k m n l + h +);
my @q = qw(a b c d e f g h i j k l m l j h h);
my @s = qw(a b c d e f g h k j k l m l j h h);

my @current_interval = (); #will store the interval we are currently working on
my @intervals = (); #keeps track of all those intervals

for(0 .. $#t){
    if($q[$_] eq $s[$_] and ($q[$_] eq $t[$_] or $t[$_] eq '+')){
        push(@current_interval, $_);
    }
    else{
        if(@current_interval){
            push(@intervals, [$current_interval[0], $current_interval[$#current_interval]]);    
            @current_interval = ();
        }
    }
}
#when exiting the loop we dont want to lose our current interval!
if(@current_interval){
push(@intervals, [$current_interval[0], $current_interval[$#current_interval]]);}   

#print intervals
for (@intervals){
    my @c = @{$_};
    print $c[0],"\t",$c[1],"\n";
}

I got the intervals for you. Please note that I added "use strict; use warnings" - before adding this solution to your project.

Greetings Tim

Upvotes: 1

Related Questions