I'm trying to code the 8 queen problem in perl and I seem to be running into an infinite loop that I cannot fix. I think the problem is with the queen increments because when I do print "$queen"; in my solve function all I get is a bunch of 1's.
#
# implement 8 queen problem
#
my $size = 8;
my #answer = ();
sub is_conflict($$){
my ($row, $queen) = #_;
for(my $i=0; $i<$queen; $i=$i+1){
my $temp = $answer[$i];
if (($temp eq $row) or #same row
($temp eq ($row - ($queen - $i))) or #same diagonal
($temp eq ($row + ($queen-$i)))){ #same diagonal
return 1; #return true
}
}
return 0; #return false
}
sub solve($){
my $queen = #_;
if($queen eq $size){
print "#answer\n";
#answer = ();
}
else{
for(my $i=0; $i<$size; $i=$i+1){
if(is_conflict($i,$queen) eq 0){
push(#answer, $i);
solve($queen+1);
}
}
}
}
solve(0);
my $queen = #_ is almost surely not what you meant.
my $var = #_ evaluates #_ in scalar context, giving you the size of #_ and not the first element of #_. In your program, you are always assigning the value 1 to $queen.
Instead, you want to say one of
my ($queen) = #_; # list context, assigns first element of #_
my $queen = shift #_; # extract first element from #_
my $queen = shift; # inside a sub, same as shift #_
Related
Say I have a number, $x = 0; and I want to increment it with a subroutine, but the subroutine won't be returning its value:
sub increment {
my ($var) = #_;
my #list = (
'a',
'b',
'c',
...
'x',
'y',
'z'
);
return $list[$var++];
}
while ($x < 10) {
print increment($x);
}
As-is, this will print aaaaaaaaaa forever instead of abcdefghij. If I replace increment($x) with increment(\$x), it converts the scalar address to a decimal number and increments that instead. In the above scenario, it ends up throwing an error because 25423331 or whatever isn't a valid array element.
If $x were an element in a hash or an array, I could pass the parent as a reference to have the original modified:
$x = {'val' => 0};
while ($x->{'val'} < 10) {
print increment($x);
}
sub increment {
...
return $list[$var->{$val}++];
}
How can I modify the original value of a scalar reference?
You can pass a reference to the variable to modify.
sub increment {
my ($ref) = #_;
++$$ref;
}
my $i = 0;
say $i; # prints 0
increment(\$i);
say $i; # prints 1
You could also take advantage of the fact that Perl passes by reference.
sub increment {
++$_[0];
}
my $i = 0;
say $i; # prints 0
increment($i);
say $i; # prints 1
But hiding the increment as such is a really bad idea. Either iterate over a list,
for my $x ('a'..'z') {
...
}
Or write an iterator.
sub make_iter {
my #list = #_;
return sub {
return #list ? shift(#list) : ();
};
}
my $iter = make_iter('a'..'z');
while (my ($x) = $iter->()) {
...
}
You need to dereference $var inside the subroutine, like this:
my $x = 0;
say $x; # prints 0
foo(\$x);
say $x; # prints 1
sub foo {
my $y = shift;
$$y++;
}
I'm having trouble using the perl splice() method. Bellow you will see that I first identify the indexes of the two strings that I am looking for and then perform splice() using the indexes to get the desired array.
My code is as follows:
my #a = qw(foo bar bazz elements in between hello bazz johnny bl aba);
my $z = 0;
for (my $i = 0; $i < #a; $i++)
{
next unless $a[$i] =~ /bazz/;
if( $z eq 0 )
{
$z++;
$first = $i;
}
else
{
$second = $i;
}
my #b = splice(#a,$first,$second);
print Dumper(#b);
}
And the result of the print is as follows:
$VAR1 = 'bazz';
$VAR2 = 'elements';
$VAR3 = 'in';
$VAR4 = 'between';
$VAR5 = 'hello';
$VAR6 = 'bazz';
$VAR7 = 'johnny';
I was under the impression that splice takes the chunk in between the given limits, inclusive of course. I don't understand why element 'johnny' would be there. Shouldn't the list stop at the second 'bazz' ?
Thank you for any pointers on this issue.
The second argument is the length of the slice, not the index of the end of the slice.
splice takes the arguments as
splice #ARRAY, $OFFSET, $LENGTH, #REPLACE_LIST;
It removes $LENGTH elements from the #ARRAY starting at index $OFFSET and replaces them by the given list (or deletes them from the array when the empty list is (implicitely) given).
It seems you want an array slice instead:
my #b = #a[$first .. $second];
print Dumper \#b;
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 an array #test. What's the best way to check if each element of the array is the same string?
I know I can do it with a foreach loop but is there a better way to do this? I checked out the map function but I'm not sure if that's what I need.
If the string is known, you can use grep in scalar context:
if (#test == grep { $_ eq $string } #test) {
# all equal
}
Otherwise, use a hash:
my %string = map { $_, 1 } #test;
if (keys %string == 1) {
# all equal
}
or a shorter version:
if (keys %{{ map {$_, 1} #test }} == 1) {
# all equal
}
NOTE: The undefined value behaves like the empty string ("") when used as a string in Perl. Therefore, the checks will return true if the array contains only empty strings and undefs.
Here's a solution that takes this into account:
my $is_equal = 0;
my $string = $test[0]; # the first element
for my $i (0..$#test) {
last unless defined $string == defined $test[$i];
last if defined $test[$i] && $test[$i] ne $string;
$is_equal = 1 if $i == $#test;
}
Both methods in the accepted post give you the wrong answer if #test = (undef, ''). That is, they declare an undefined value to be equal to the empty string.
That might be acceptable. In addition, using grep goes through all elements of the array even if a mismatch is found early on and using the hash more than doubles the memory used by elements of array. Neither of these would be a problem if you have small arrays. And, grep is likely to be fast enough for reasonable list sizes.
However, here is an alternative that 1) returns false for (undef, '') and (undef, 0), 2) does not increase the memory footprint of your program and 3) short-circuits as soon as a mismatch is found:
#!/usr/bin/perl
use strict; use warnings;
# Returns true for an empty array as there exist
# no elements of an empty set that are different
# than each other (see
# http://en.wikipedia.org/wiki/Vacuous_truth)
sub all_the_same {
my ($ref) = #_;
return 1 unless #$ref;
my $cmpv = \ $ref->[-1];
for my $i (0 .. $#$ref - 1) {
my $this = \ $ref->[$i];
return unless defined $$cmpv == defined $$this;
return if defined $$this
and ( $$cmpv ne $$this );
}
return 1;
}
However, using List::MoreUtils::first_index is likely to be faster:
use List::MoreUtils qw( first_index );
sub all_the_same {
my ($ref) = #_;
my $first = \ $ref->[0];
return -1 == first_index {
(defined $$first != defined)
or (defined and $_ ne $$first)
} #$ref;
}
TIMTOWTDI, and I've been reading a lot of Mark Jason Dominus lately.
use strict;
use warnings;
sub all_the_same {
my $ref = shift;
return 1 unless #$ref;
my $cmp = $ref->[0];
my $equal = defined $cmp ?
sub { defined($_[0]) and $_[0] eq $cmp } :
sub { not defined $_[0] };
for my $v (#$ref){
return 0 unless $equal->($v);
}
return 1;
}
my #tests = (
[ qw(foo foo foo) ],
[ '', '', ''],
[ undef, undef, undef ],
[ qw(foo foo bar) ],
[ '', undef ],
[ undef, '' ]
);
for my $i (0 .. $#tests){
print "$i. ", all_the_same($tests[$i]) ? 'equal' : '', "\n";
}
You can check how many times the element in the array (#test) is repeated by counting it in a hash (%seen). You can check how many keys ($size) are present in the hash (%seen). If more than 1 key is present, you know that the elements in the array are not identical.
sub all_the_same {
my #test = #_;
my %seen;
foreach my $item (#test){
$seen{$item}++
}
my $size = keys %seen;
if ($size == 1){
return 1;
}
else{
return 0;
}
}
I think, we can use List::MoreUtils qw(uniq)
my #uniq_array = uniq #array;
my $array_length = #uniq_array;
$array_length == 1 ? return 1 : return 0;
I use List::Util::first for all similar purposes.
# try #0: $ok = !first { $_ ne $string } #test;
# try #1: $ok = !first { (defined $_ != defined $string) || !/\A\Q$string\E\z/ } #test;
# final solution
use List::Util 'first';
my $str = shift #test;
my $ok = !first { defined $$_ != defined $str || defined $str && $$_ ne $str } map \$_, #test;
I used map \$_, #test here to avoid problems with values that evaluate to false.
Note. As cjm noted fairly, using map defeats the advantage of first short-circuiting. So I tip my hat to Sinan with his first_index solution.