Related
I was trying to think in the right way to tackle this:
-I would to pass say, n elements array as argument to a subroutine. And for each element match two char types S and T and print for each element, the count of these letters. So far I did this but I am locked and found some infinite loops in my code.
use strict;
use warnings;
sub main {
my #array = #_;
while (#array) {
my $s = ($_ = tr/S//);
my $t = ($_ = tr/T//);
print "ST are in total $s + $t\n";
}
}
my #bunchOfdata = ("QQQRRRRSCCTTTS", "ZZZSTTKQSST", "ZBQLDKSSSS");
main(#bunchOfdata);
I would like the output to be:
Element 1 Counts of ST = 5
Element 2 Counts of ST = 6
Element 3 Counts of ST = 4
Any clue how to solve this?
while (#array) will be an infinite loop since #array never gets smaller. You can't read into the default variable $_ this way. For this to work, use for (#array) which will read the array items into $_ one at a time until all have been read.
The tr transliteration operator is the right tool for your task.
The code needed to get your results could be:
#!/usr/bin/perl
use strict;
use warnings;
my #data = ("QQQRRRRSCCTTTS", "ZZZSTTKQSST", "ZBQLDKSSSS");
my $i = 1;
for (#data) {
my $count = tr/ST//;
print "Element $i Counts of ST = $count\n";
$i++;
}
Also, note that my $count = tr/ST//; doesn't require the binding of the transliteration operator with $_. Perl assumes this when $_ holds the value to be counted here. Your code tried my $s = ($_ = tr/S//); which will give the results but the shorter way I've shown is the preferred way.
(Just noticed you had = instead of =~ in your statement. That is an error. Has to be $s = ($_ =~ tr/S//);)
You can combine the 2 sought letters as in my code. Its not necessary to do them separately.
I got the output you want.
Element 1 Counts of ST = 5
Element 2 Counts of ST = 6
Element 3 Counts of ST = 4
Also, you can't perform math operations in a quoted string like you had.
print "ST are in total $s + $t\n";
Instead, you would need to do:
print "ST are in total ", $s + $t, "\n";
where the operation is performed outside of the string.
Don't use while to traverse an array - your array gets no smaller, so the condition is always true and you get an infinite loop. You should use for (or foreach) instead.
for (#array) {
my $s = tr/S//; # No need for =~ as tr/// works on $_ by default
my $t = tr/T//;
print "ST are in total $s + $t\n";
}
Why tr///??
sub main {
my #array = #_;
while (#array) {
my $s = split(/S/, $_, -1) - 1;
my $t = split(/T/, $_, -1) - 1;
print "ST are in total $s + $t\n";
}
}
I'm trying to construct a permutation program in Perl using the NestedLoops function. Here's my code:
use strict;
use warnings;
use Algorithm::Loops qw(NestedLoops);
my #a = 'a'..'o';
my $length = 5;
my $start = 0;
my $depth = 2;
NestedLoops([
[0..$length],
( sub {
$start = 0 if $start == $depth;
$start++;
[$start * $length..$start * $length + $length - 1]
}) x $depth,
], \&permute,);
sub permute {
my #ind = #_;
foreach my $i (#ind) {
print $a[$i];
}
print "\n";
}
So I've got an array that holds the letters 'a' to 'o' (size being 15). I'm treating the array as if it had 3 rows, so my imagination of the array is this:
abcde
fghij
klmno
Then each loop corresponds to each row... and I want to build permutations like:
afk
afl
afm
afn
afo
agk // fails here... I end up getting agg
...
It works for the first 5 values (the entire run of the lowest for loop), but then the second run fails because the last row's value of $start gets reset to 0... this is a problem because that breaks everything.
So what I want to know is, how can I keep the value of $start persistent based on the level... So what I'm asking for is essentially having constants. My loops really should look like this:
for my $a (0..5) { # 0 at this level and never change
for my $b (5..10) { # $start should be 5 at this level and never change
for my $c (10..15) { # $start should be 10 at this level and never change
permute($a, $b, $c);
}
}
}
Now, because I will have a variable length of for loops, I can't hard code each start value, so I'm looking for a way to initially create those start values, and then keep them for when the loop gets reset.
I realize this is a confusing question, so please ask questions, and I will help clarify.
You are making this harder than it has to be.
Part of the problem is that the documentation for NestedLoops doesn't go into much detail about how a subroutine reference in the first argument, will be used.
For the following examples, assume this is written somewhere above them.
use strict;
use warnings;
use Algorithm::Loops qw'NestedLoops';
Really the simplest way to call NestedLoops to get what you want is like this:
NestedLoops(
[
['a'..'e'],
['f'..'j'],
['k'..'o'],
],
\&permute
);
sub permute {
print #_, "\n";
}
If you really want the arguments to NestedLoops to be generated on the fly, I would recommend using part from List::MoreUtils.
use List::MoreUtils qw'part';
my #a = 'a'..'o';
my $length = 5;
my $index;
NestedLoops(
[
part {
$index++ / $length
} #a
],
\&permute
);
sub permute {
print #_, "\n";
}
If for some reason you want to call NestedLoops with indexes into the array, It is still easy with part.
use List::MoreUtils qw'part';
my #a = 'a'..'o';
my $length = 5;
NestedLoops(
[
part {
$_ / $length
} 0..#a-1
],
\&permute
);
sub permute {
print map { $a[$_] } #_;
print "\n";
}
Really the main problem you're having is that the two subroutine references that you give to NestedLoops are modifying the same variables, and they are both called multiple times.
The best way to fix this is to rely on the last value given to the subroutine when it is called. ( From looking at the implementation, this seems to be closer to how it was meant to be used. )
my #a = 'a'..'o';
my $length = 5;
my $depth = 3;
NestedLoops(
[
[0..$length-1],
(sub{
return unless #_;
my $last = pop;
my $part = int( $last / $length ) + 1; # current partition
my $start = $part * $length; # start of this partition
my $end = $start + $length;
[$start..$end-1] # list of variables in this partition
}) x ($depth-1)
],
\&permute
);
sub permute {
print map { $a[$_] } #_;
print "\n";
}
When you use a subroutine to generate the range of a loop, it is called every time that one of the nested loops must start. That means once for each iteration of the containing loop. Before each call $_ is set to the current value of the containing loop's variable, and the values of all the containing loop variables are passed as parameters.
To clarify this, the NestedLoops statement you have coded is equivalent to
sub loop_over {
$start = 0 if $start == $depth;
$start++;
[$start * $length..$start * $length + $length - 1]
};
NestedLoops([
[0..$length],
(\&loop_over) x $depth,
], \&permute,);
which, in raw Perl, looks something like
for my $i (0 .. $length) {
$_ = $i;
my $list = loop_over($i);
for my $j (#$list) {
$_ = $j;
my $list = loop_over($i, $j);
for my $k (#$list) {
permute($i, $j, $k);
}
}
}
so perhaps it is clearer now that your calculation of $start is wrong? It is reevaluated several times for the innermost level before execution ascends to restart the containing loop.
Since the parameters passed to the subroutine consist of all the values of the containing loop variables, the size of #_ can be checked to see for which level of the loop to generate a range. For instance, in the code above, if #_ contains two values they are $i and $j, so the values for $k must be returned; alternatively, if there is only one parameter then it is the value of $i, and the returned value must be the range for $j. So the correct value for your $start is simply the number of elements in #_ and can be set using my $start = #_;.
Using this method the subroutine can return the range for the outermost loop as well. The code looks like this
use strict;
use warnings;
use Algorithm::Loops qw(NestedLoops);
my #a = 'a'..'o';
my $length = 5;
my $start = 0;
my $depth = 2;
NestedLoops([
(sub {
$start = #_;
[$start * $length .. $start * $length + $length - 1];
}) x ($depth + 1)
], \&permute,);
sub permute {
print map { $a[$_] } #_;
print "\n";
}
I have two arrays:
#array1 = (A,B,C,D,E,F);
#array2 = (A,C,H,D,E,G);
The arrays could be of different size. I want to find how many mismatches are there between the arrays. The indexes should be the same. In this case there are three mismatch :b->c,c->h and F->G.(i.e , The 'C' in $array[2] should not be considered a match to 'C' in $array[1]) I would like to get the number of mismatches as well as the mismatch.
foreach my $a1 ( 0 .. $#array1) {
foreach my $a2( 0 .. $#array2)
if($array1[$a1] ne $array2[$a2]) {
}
}
}
my %array_one = map {$_, 1} #array1;
my #difference = grep {!$array_one {$_}} #array1;
print "#difference\n";
Ans: gives me H, G but not C.
with my little Perl knowledge I tried this, with no result. Could you suggest me how I should deal this? Your suggestions and pointers would be very helpful.
You shouldn't have nested loops. You only need to go through the indexes once.
use List::Util qw( max );
my #mismatches;
for my $i (0..max($#array1, $#array2)) {
push #mismatches, $i
if $i >= #array1
|| $i >= #array2
|| $array1[$i] ne $array2[$i];
}
}
say "There are " . (0+#mismatches) . " mismatches";
for my $i (#mismatches) {
...
}
Since you mentioned grep, this is how you'd replace the for with grep:
use List::Util qw( max );
my #mismatches =
grep { $_ >= #array1
|| $_ >= #array2
|| array1[$_] ne $array2[$_] }
0 .. max($#array1, $#array2);
say "There are " . (0+#mismatches) . " mismatches";
for my $i (#mismatches) {
...
}
Here's an example using each_arrayref from List::MoreUtils.
sub diff_array{
use List::MoreUtils qw'each_arrayref';
return unless #_ && defined wantarray;
my #out;
my $iter = each_arrayref(#_);
my $index = 0;
while( my #current = $iter->() ){
next if all_same(#current);
unshift #current, $index;
push #out, \#current;
}continue{ ++$index }
return #out;
}
This version should be faster if you are going to use this for determining the number of differences often. The output is exactly the same. It just doesn't have to work as hard when returning a number.
Read about wantarray for more information.
sub diff_array{
use List::MoreUtils qw'each_arrayref';
return unless #_ && defined wantarray;
my $iter = each_arrayref(#_);
if( wantarray ){
# return structure
my #out;
my $index = 0;
while( my #current = $iter->() ){
next if all_same(#current);
unshift #current, $index;
push #out, \#current;
}continue{ ++$index }
return #out;
}else{
# only return a count of differences
my $out = 0;
while( my #current = $iter->() ){
++$out unless all_same #current;
}
return $out;
}
}
diff_array uses the subroutine all_same to determine if all of the current list of elements are the same.
sub all_same{
my $head = shift;
return undef unless #_; # not enough arguments
for( #_ ){
return 0 if $_ ne $head; # at least one mismatch
}
return 1; # all are the same
}
To get just the number of differences:
print scalar diff_array \#array1, \#array2;
my $count = diff_array \#array1, \#array2;
To get a list of differences:
my #list = diff_array \#array1, \#array2;
To get both:
my $count = my #list = diff_array \#array1, \#array2;
The output for the input you provided:
(
[ 1, 'B', 'C' ],
[ 2, 'C', 'H' ],
[ 5, 'F', 'G' ]
)
Example usage
my #a1 = qw'A B C D E F';
my #a2 = qw'A C H D E G';
my $count = my #list = diff_array \#a1, \#a2;
print "There were $count differences\n\n";
for my $group (#list){
my $index = shift #$group;
print " At index $index\n";
print " $_\n" for #$group;
print "\n";
}
You're iterating over both arrays when you don't want to be doing so.
#array1 = ("A","B","C","D","E","F");
#array2 = ("A","C","H","D","E","G");
foreach my $index (0 .. $#array1) {
if ($array1[$index] ne $array2[$index]) {
print "Arrays differ at index $index: $array1[$index] and $array2[$index]\n";
}
}
Output:
Arrays differ at index 1: B and C
Arrays differ at index 2: C and H
Arrays differ at index 5: F and G
Well, first, you're going to want to go over each element of one of the arrays, and compare it to the same element of the other array. List::MoreUtils provides an easy way to do this:
use v5.14;
use List::MoreUtils qw(each_array);
my #a = qw(a b c d);
my #b = qw(1 2 3);
my $ea = each_array #a, #b;
while ( my ($a, $b) = $ea->() ) {
say "a = $a, b = $b, idx = ", $ea->('index');
}
You can extend that to find where there is a non-match by checking inside that while loop (note: this assumes your arrays don't have undefs at the end, or that if they do, undef is the same as having a shorter array):
my #mismatch;
my $ea = each_array #a, #b;
while ( my ($a, $b) = $ea->() ) {
if (defined $a != defined $b || $a ne $b) {
push #mismatch, $ea->('index');
}
}
and then:
say "Mismatched count = ", scalar(#mismatch), " items are: ", join(q{, }, #mismatch);
The following code builds a list of mismatched pairs, then prints them out.
#a1 = (A,B,C,D,E,F);
#a2 = (A,C,H,D,E,G);
#diff = map { [$a1[$_] => $a2[$_]] }
grep { $a1[$_] ne $a2[$_] }
(0..($#a1 < $#a2 ? $#a1 : $#a2));
print "$_->[0]->$_->[1]\n" for #diff
You have the right idea, but you only need a single loop, since you are looking at each index and comparing entries between the arrays:
foreach my $a1 ( 0 .. $#array1) {
if($array1[$a1] ne $array2[$a1]) {
print "$a1: $array1[$a1] <-> $array2[$a1]\n";
}
}
I am writing this loop where in the initializing i am intializing using a variable and not a absolute value.Why doesn't the value change? Or is it not allowed in the for loop?
enter code here
for($i = $one, $i > $top_level,$i--)
{
print $i,"\n";
print "One is:",$one,"\n";
}
Why can't i assign $i= $one.
The variable $one keeps changing so thats the reason why i declared $i to $one.When i print the individual values of the variables the values are correct, its just that in the for loop the value is not being assigned.
Use semicolons, not commas.
for($i = $one; $i > $top_level; $i--)
{
print $i,"\n";
print "One is:",$one,"\n";
}
Avoid C-Style loops in perl, if possible.
for my $i (reverse $top_level..$one) {
print $i,"\n";
print "One is:",$one,"\n";
}
The separator inside the for() statement is ";", not ",".
You've accidentally stumbled on using for with a list, by using commas instead of semi-colons. Watch what happens when you add a third print statement:
print "\$_=[$_]\n";
with $one as 1, I get:
$_=[0]
...
$_=[]
...
$_=[1]
And that is because there are three items in the list. First of all what you wanted to do, would have looked like this:
for my $i ( $one..( $top_level - 1 )) {
In this loop, $i is set to each member of the range and then the loop is executed. If we don't suppy the variable, perl assigns it to $_.
for ( $one..( $top_level - 1 )) {
And perl does not wait to compile the list, so before it ever execute the first time it goes through all the terms.
$i = $one;
# push actual $i returned by expression $i = $one
push #a, $i;
# result = [ $i=1 ]
# push boolean false => ''
push #a, ( $i > $top_level );
# result = [ $i=1, '' ]
# push the return of $i--, NOT $i
push #a, ( $i );
# result = [ $i=1, '', 1 ]
# decrement $i
$i--;
# result = [ $i=0, '', 1 ]
You can find this out using a TIE-ed scalar:
package Monitored;
sub TIESCALAR {
my ( $class, $name, $value ) = #_;
return bless { name => $name, value => $value }, $class;
}
sub FETCH {
my $self = shift;
Carp::carp "Reading \$$self->{name}...";
return $self->{value};
}
sub STORE {
my $self = shift;
my $value = shift;
Carp::carp "Storing \$$self->{name}=${\(defined( $value ) ? $value : 'undef')} ";
$self->{value} = $value;
}
And this initialization in the mainline:
my $one = 1;
tie my $i, 'Monitored', 'i';
tie my $top_level, 'Monitored', 'top_level', 5;
for($i = $one, $i > $top_level,$i--) # line 30
{
print "*LOOP*\n";
#print "\$i=$i\n"; <-- commented out to reduce noise
#print "\$one=$one\n";
print "\$_=[$_]\n"; # line 35
}
Then in running the loop the output is:
Storing $i=1 at - line 30
Reading $top_level... at - line 30
Reading $i... at - line 30
Reading $i... at - line 30
Reading $i... at - line 30
Storing $i=0 at - line 30
*LOOP*
Reading $i... at - line 35
$_=[0]
*LOOP*
$_=[]
*LOOP*
$_=[1]
Note that only one time, at line 35, do we access $i after the looping starts.
What on earth are you trying to do? Is this a normal 'for' loop or are you trying to do something exotic. Note use of semicolon, NOT comma. Using a comma in any loop does something completely different: runs each bit of code each time.
Normally it would be:
$one = 1;
for($i = $one; $i > $top_level;$i--)
{
print $i,"\n";
print "One is:",$one,"\n";
}
It is Perl right?
I have two arrays, #a and #b. I want to do a compare among the elements of the two arrays.
my #a = qw"abc def efg ghy klm ghn";
my #b = qw"def ghy jgk lom com klm";
If any element matches then set a flag. Is there any simple way to do this?
First of all, your 2 arrays need to be written correctly.
#a = ("abc","def","efg","ghy","klm","ghn");
#b = ("def","efg","ghy","klm","ghn","klm");
Second of all, for arbitrary arrays (e.g. arrays whose elements may be references to other data structures) you can use Data::Compare.
For arrays whose elements are scalar, you can do comparison using List::MoreUtils pairwise BLOCK ARRAY1 ARRAY2, where BLOCK is your comparison subroutine. You can emulate pairwise (if you don't have List::MoreUtils access) via:
if (#a != #b) {
$equals = 0;
} else {
$equals = 1;
foreach (my $i = 0; $i < #a; $i++) {
# Ideally, check for undef/value comparison here as well
if ($a[$i] != $b[$i]) { # use "ne" if elements are strings, not numbers
# Or you can use generic sub comparing 2 values
$equals = 0;
last;
}
}
}
P.S. I am not sure but List::Compare may always sort the lists. I'm not sure if it can do pairwise comparisons.
List::Compare
if ( scalar List::Compare->new(\#a, \#b)->get_intersection ) {
…
}
Check to create an intersect function, which will return a list of items that are present in both lists. Then your return value is dependent on the number of items in the intersected list.
You can easily find on the web the best implementation of intersect for Perl. I remember looking for it a few years ago.
Here's what I found :
my #array1 = (1, 2, 3);
my #array2 = (2, 3, 4);
my %original = ();
my #isect = ();
map { $original{$_} = 1 } #array1;
#isect = grep { $original{$_} } #array2;
This is one way:
use warnings;
use strict;
my #a = split /,/, "abc,def,efg,ghy,klm,ghn";
my #b = split /,/, "def,ghy,jgk,lom,com,klm";
my $flag = 0;
my %a;
#a{#a} = (1) x #a;
for (#b) {
if ($a{$_}) {
$flag = 1;
last;
}
}
print "$flag\n";
From the requirement that 'if any element matches', use the intersection of sets:
sub set{
my %set = map { $_, undef }, #_;
return sort keys %set;
}
sub compare{
my ($listA,$listB) = #_;
return ( (set(#$listA)-set(#$listB)) > 0)
}
my #a = qw' abc def efg ghy klm ghn ';
my #b = qw' def ghy jgk lom com klm ';
my $flag;
foreach my $item(#a) {
$flag = #b~~$item ? 0 : 1;
last if !$flag;
}
Note that you will need Perl 5.10, or later, to use the smart match operator (~~) .
Brute force should do the trick for small a n:
my $flag = 0;
foreach my $i (#a) {
foreach my $k (#b) {
if ($i eq $k) {
$flag = 1;
last;
}
}
}
For a large n, use a hash table:
my $flag = 0;
my %aa = ();
$aa{$_} = 1 foreach (#a);
foreach my $i (#b) {
if ($aa{$i}) {
$flag = 1;
last;
}
}
Where a large n is |#a| + |#b| > ~1000 items
IMHO, you should use List::MoreUtils::pairwise. However, if for some reason you cannot, then the following sub would return a 1 for every index where the value in the first array compares equal to the value in the second array. You can generalize this method as much as you want and pass your own comparator if you want to, but at that point, just installing List::MoreUtils would be a more productive use of your time.
use strict; use warnings;
my #a = qw(abc def ghi jkl);
my #b = qw(abc dgh dlkfj jkl kjj lkm);
my $map = which_ones_equal(\#a, \#b);
print join(', ', #$map), "\n";
sub which_ones_equal {
my ($x, $y, $compare) = #_;
my $last = $#$x > $#$y ? $#$x : $#$y;
no warnings 'uninitialized';
return [ map { 0 + ($x->[$_] eq $y->[$_]) } $[ .. $last ];
}
This is Perl. The 'obvious' solution:
my #a = qw"abc def efg ghy klm ghn";
my #b = qw"def ghy jgk lom com klm";
print "arrays equal\n"
if #a == #b and join("\0", #a) eq join("\0", #b);
given "\0" not being in #a.
But thanks for confirming that there is no other generic solution than rolling your own.
my #a1 = qw|a b c d|;
my #a2 = qw|b c d e|;
for my $i (0..$#a1) {
say "element $i of array 1 was not found in array 2"
unless grep {$_ eq $a1[$i]} #a2
}
If you would consider the arrays with different order to be different, you may use Array::Diff
if (Array::Diff->diff(\#a, \#b)->count) {
# not_same
} else {
# same
}
This question still could mean two things where it states "If any element matches then set a flag":
Elements at the same position, i.e $a[2] eq $b[2]
Values at any position, i.e. $a[3] eq $b[5]
For case 1, you might do this:
# iterate over all positions, and compare values at that position
my #matches = grep { $a[$_] eq $b[$_] } 0 .. $#a;
# set flag if there's any match at the same position
my $flag = 1 if #matches;
For case 2, you might do that:
# make a hash of #a and check if any #b are in there
my %a = map { $_ => 1 } #a;
my #matches = grep { $a{$_} } #b;
# set flag if there's matches at any position
my $flag = 1 if #matches;
Note that in the first case, #matches holds the indexes of where there are matching elements, and in the second case #matches holds the matching values in the order in which they appear in #b.