I'm having difficulty understanding the behaviour of the map function in the Perl script below
my #list = qw/A C T G/;
my #curr = (0, undef, undef, 1);
my #res = map { $list[ $_ ] } #curr;
print #res; #prints AAAC
The value of #res is AAAC. I had expected it be just AC as the 2 middle values of #curr are undef.
My understanding of map is that each item from the list becomes the value of $_ in turn. So I can understand how $list[0] returns A and how $list[1] returns C. I can't understand why/how the undef values have returned A? To my mind $list[undef] would not be a value?
I'm missing something obvious here probably, but would be really grateful for some help
The script that I take this code from is below. I'm stepping through it in the debugger, and I can see this behaviour in the last line returned by sub gen_permutate
my #DNA = qw/A C T G/;
my $seq = gen_permutate(14, #DNA);
while ( my $strand = $seq->() ) {
print "$strand\n";
}
sub gen_permutate {
my ($max, #list) = #_;
my #curr;
return sub {
if ( (join '', map { $list[ $_ ] } #curr) eq $list[ -1 ] x #curr ) {
#curr = (0) x (#curr + 1);
else {
my $pos = #curr;
while ( --$pos > -1 ) {
++$curr[ $pos ], last if $curr[ $pos ] < $#list;
$curr[ $pos ] = 0;
}
}
return undef if #curr > $max;
return join '', map { $list[ $_ ] } #curr;
};
}
J
This is a part of "DWIM" -- an array index need be a number, so what is passed in is converted to one, as best as the interpreter can do/guess. In case of undef at least it's clear -- becomes a 0.
But it's really a programming error, or at least sloppiness.
To do what you expect:
my #res = map { $list[ $_ ] } grep { defined } #curr;
or, in one iteration over the list
my #res = map { defined $_ ? $list[$_] : () } #curr;
Here the empty list, indicated by (), gets flattened into the return list, thus disappearing; so we filter inside map as well. But the point of that ternary is to be able to put something meaningful instead, and if some input need be just removed then having an explicit grep first is clearer.
NOTE With use warnings; in place you'd hear all about it
Use of uninitialized value $_ in array element at ...
(and it would convert it to a number)
Each script really must begin with use warnings; (and use strict;). Sometimes the biggest part in inheriting older scripts is to stick use warnings; on top right away (and work through the screenfulls of messages :(.
I think to answer my own question, that undef is sometimes treated as zero. That is why $list[undef] is the same as $list[0]
Related
I want to compare the hash if the key-value pairs are same in the second hash. I don't want to use smartmatch as it gives warnings.
What is the best way to compare two hashes with integers,strings and maybe also arrays in it?
use warnings;
use diagnostics;
my $hash1={"key_str"=>"a string", "key_int"=>4};
my $hash2={"key_str"=>"b string", "key_int"=>2};
foreach my $key ( keys(%$hash1) ) {
if ($hash1->{$key} != $hash2->{$key}) {
print($key);
}
}
the output as expected is:
Argument "b string" isn't numeric in numeric ne (!=) at hash_compare.pl line 8 (#1)
(W numeric) The indicated string was fed as an argument to an operator
that expected a numeric value instead. If you're fortunate the message
will identify which operator was so unfortunate.
Argument "a string" isn't numeric in numeric ne (!=) at hash_compare.pl line 8 (#1)
First, Perl does not have types. It does not distinguish between strings and numbers (on the outside).
Furthermore, it does not make a difference between numbers and strings on this level. The numerical context and string context matters if you check what's greater or less than. Consider this:
my $foo = 200;
my $bar = 99;
print $foo > $bar ? $foo : $bar;
Obviously it will print 200, because 200 is numerically larger than 99.
my $foo = 200;
my $bar = 99;
print $foo gt $bar ? $foo : $bar;
But this will print 99, because 9 is alphanumerically (as in string) greater than 2. It compared the numbers of the code points for the characters.
But if all you want to do is check for inequality, the ne operator is fine. Even when you are not sure whether there are things other than numbers in your input.
foreach my $key ( keys(%$hash1) ) {
if ($hash1->{$key} ne $hash2->{$key}) {
print($key);
}
}
eq (and ne) are smart enough to see if a number was initially a string or a number without quotes, because the internal representation of those differs.
Warning, technical details ahead.
Scalar values are saved in _SV_s. These in terms can contain different things. There's a special internal type for simple integers called IV, and also one called PV for strings. Perl internally converts between those two as needed when you use numbers inside of strings, or vise versa.
You can get some debugging information about the internal representation of data with Dump from Devel::Peek.
use Devel::Peek;
Dump("01");
Dump(01);
This will output:
SV = PV(0x19560d0) at 0x19327d0
REFCNT = 1
FLAGS = (POK,READONLY,IsCOW,pPOK)
PV = 0x1c94fd0 "01"\0
CUR = 2
LEN = 10
COW_REFCNT = 0
SV = IV(0x19739b0) at 0x19739c0
REFCNT = 1
FLAGS = (IOK,READONLY,pIOK)
IV = 1
As you can see, the first one is a string, and the second one is a number.
But if we do this
print "01" eq 01;
there is no output, because the 01 is an integer and will be converted to "1" for comparison. Since the 0 of "01" is not equal to 1, nothing gets printed.
If the values of your data structures are more complex, you need to walk the structure. Each type of element needs to have its own handling. There could be array references, hash references, scalar references, scalars, glob references, dualvars and so on. There might be objects that you want to treat specially.
I suggest taking a look at how Test::Deep implements this. If you decide to use it in production code (and not a unit test), you can use Test::Deep::NoTest.
You can use Scalar::Util qw( looks_like_number ); to determine if the value is a number or a string. Scalar::Util is a standard module that is included with Perl. For a list of standard modules, see perldoc perlmodlib.
#!/usr/bin/env perl
# always use these two
use strict;
use warnings;
# handle errors in open and close
use autodie; # See http://perldoc.perl.org/autodie.html
use Scalar::Util qw( looks_like_number );
my $hash1={"key_str"=>"a string", "key_int"=>4};
my $hash2={"key_str"=>"b string", "key_int"=>2};
foreach my $key ( keys(%$hash1) ) {
if( looks_like_number( $hash1->{$key} ) && looks_like_number( $hash2->{$key} ) ){
if ($hash1->{$key} != $hash2->{$key}) {
print "number value of $key is different\n";
}
}else{
if ($hash1->{$key} ne $hash2->{$key}) {
print "string value of $key is different\n";
}
}
}
I've written a program that doesn't use any module. I've tested below program for many cases, worked fine, but if you find any case where it fails then please let me know.
Always use ne to compare if you are not sure of datatype to be compared. != works only for integers, ne for integers and strings both.
use strict;
use warnings;
use feature 'say';
my $hash1 = {
'key1' => 'value1',
'key2' => [1, 2, 2],
'key3' => {1=>1, 2=> [5, 7]},
};
my $hash2 = {
'key1' => 'value1',
'key2' => [1, 2, 2],
'key3' => {1=>1, 2=> [5, 7]},
};
my $is_same = 0;
$is_same = compare($hash1, $hash2);
if ($is_same) {
say "Same";
} else {
say "Not same";
}
sub compare {
my ($value1, $value2) = #_;
my $is_same = 1;
if (ref($value1) eq "ARRAY") {
if (is_same_sized_array($value1, $value2)) {
foreach (my $i = 0; $i < #$value1; $i++) {
if (ref $value1->[$i] eq ref $value2->[$i]) {
$is_same = compare($value1->[$i], $value2->[$i]);
return 0 unless $is_same;
} else {
return 0;
}
}
} else {
return 0;
}
} elsif (ref($value1) eq "HASH") {
if (is_same_sized_array([keys %$value1], [keys %$value2])) {
foreach my $key (sort keys %$value1) {
if (exists $value2->{$key} && ref $value1->{$key} eq ref $value2->{$key}) {
$is_same = compare($value1->{$key}, $value2->{$key});
return 0 unless $is_same;
} else {
return 0;
}
}
} else {
return 0;
}
} else {
if ($value1 ne $value2) {
return 0;
}
}
return $is_same;
}
sub is_same_sized_array {
my ($arr1, $arr2) = #_;
return (#$arr1 == #$arr2) || 0;
}
The code below does what I want it to. It prints the list and adds an asterisk at the end of lines that are not sequential, e.g. if you skip from 1 to 3 or 3 to 5.
use strict;
use warnings;
#note: thanks to all who helped with formatting issues.
#note: I recognize a hash would be a much better option for what I want to do.
my #printy = ("1 -> this",
"5 -> that",
"3 -> the other",
"6 -> thus and such");
#printy = sort {num($a) <=> num($b)} #printy;
my $thisID = 0;
my $lastID = 0;
#print out (line)* if initial number is >1 more than previous, or just (line) otherwise
for (#printy)
{
$thisID = $_; $thisID =~s/ .*//g;
if ($thisID - $lastID != 1) { $_ =~ s/$/ \*/; }
$lastID = $thisID;
}
print join("\n", #printy) . "\n";
sub num
{
my $x = $_[0];
$x =~ s/ .*//;
return $x;
}
But I think I can do better. It feels tangled, and my intuition tells me I'm missing something powerful that could do the job more easily, one that takes maybe two lines.
Now I've used the map() command before, but only to look at/modify an element, not how it compares to a previous element. Can anyone recommend a way to make this more succinct? Thanks!
Since Perl promotes TIMTOWTDI, map may seem like an attractive option at first. Let's see how it fares for this task:
Schwartzian thought process
Since access to neighboring elements is necessary, it's convenient to work with the indices. Since for n elements, there are n-1 pairs of neighbors, you don't have to loop n times. In this case, let's start with 1 instead of the usual 0:
1 .. $#printy
One can access neighboring elements by calling the relevant indices inside map.
map { my $prev = $printy[$_-1]; my $curr = $printy[$_] } 1 .. $#printy;
An array slice expresses this more succinctly:
map { my ( $prev, $curr ) = #printy[$_-1,$_]; } 1 .. $#printy;
Let's introduce the real logic related to comparing numbers using the num subroutine:
map {
my ( $prev, $curr ) = #printy[$_-1,$_];
if ( num($curr) - num($prev) > 1 ) {
"$curr *";
}
else {
$curr;
}
} 1 .. $#printy;
Which is equivalent to:
map {
my ( $prev, $curr ) = #printy[$_-1,$_];
$curr .= " *" if num($curr) - num($prev) > 1;
$curr
} 1 .. $#printy;
Remember not to forget the first element:
#printy = ( $printy[0],
map {
my ( $prev, $curr ) = #printy[$_-1,$_];
$curr .= " *" if num($curr) - num($prev) > 1;
$curr
} 1 .. $#printy
);
Given the final result, I'm not so sure I'd use map for this:
It's hard to read
There's a lot going on
The next person working on your code will love you
No map needed, just add some spaces here and there, and remove stuff that's not needed ($_, join, etc.). Also, reuse num() inside the loop, no need to repeat the regex.
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
my #printy = sort { num($a) <=> num($b) }
'1 -> this', '5 -> that', '3 -> the other', '6 -> thus and such';
my $thisID = my $lastID = 0;
for (#printy) {
$thisID = num($_);
$_ .= ' *' if $thisID - $lastID != 1;
$lastID = $thisID;
}
say for #printy;
sub num {
my ($x) = #_;
$x =~ s/ .*//;
return $x;
}
Also, reimplementing num using /(\d+)/ instead of substitution might tell its purpose more clearly.
I agree with choroba that there is no need for a map here. But I'd refactor a little bit anyway.
use strict;
use warnings;
use feature 'say';
my #printy = ( "1 -> this", "5 -> that", "3 -> the other", "6 -> thus and such" );
my $last_id = 0;
foreach my $line ( sort { num($a) <=> num($b) } #printy ) {
my $current_id = num($line);
$line .= ' *' unless $current_id - $last_id == 1;
$last_id = $current_id;
}
say for #printy;
# returns the number at the start of a string
sub num {
$_[0] =~ m/^(\d+)/;
return $1;
}
I moved the sort down into the foreach, because you shouldn't rely on the fact that your input is sorted.
I changed the variable names to go with the convention that there should be no capital letters in variable names, and I used say, which is like print with a system-specific newline at the end.
I also moved the $current_id into the loop. That doesn't need to be visible outside because it's lexical to that loop. Always declare variables in the smallest possible scope.
You already had that nice num function, but you're not using it inside of the loop to get the $current_id. Use it.
I think if the input gets very long, it might make sense to go with a map construct because sorting will be very expensive at some point. Look at the Schwartzian transform for caching the calculation before sorting. You could then do everything at once. But it won't be readable for a beginner any more.
Your data yells "Use a hash!" to me.
If we had a hash,
my %printy =
map { split / -> / }
"1 -> this", "5 -> that", "3 -> the other", "6 -> thus and such";
The solution would simply be:
my #order = sort { $a <=> $b } keys(%printy);
for my $i (#order[1..$#order]) {
$printy{$i} .= ' *'
if !exists($printy{$i-1});
}
print "$_ -> $printy{$_}\n"
for #order;
This can be golfed down, though I'm not sure it's worth it.
my $count;
print "$_ -> $printy{$_}".( !$count++ || exists($printy{$_-1}) ? "" : " *" )."\n"
for
sort { $a <=> $b }
keys(%printy);
That for can be converted into a map, but it just makes it less efficient.
my $count;
print
map { "$_ -> $printy{$_}".( !$count++ || exists($printy{$_-1}) ? "" : " *" )."\n" }
sort { $a <=> $b }
keys(%printy);
I'd also advise to clean up the code and keep the loop. However, here is a map based way.
The code uses your sorted #printy and the num sub.
my #nums = map { num($_) } #printy;
my #res = map {
$nums[$_] == $nums[$_-1] + 1 # invariably false for $_ == 0
? $printy[$_] : $printy[$_] .= ' *';
}
(0..$#printy);
say for #res;
This works for the first element since it does not come after the last, given that we're sorted. That may be a bit diabolical though and it needs a comment in code. So perhaps better spell it out
my #res = map {
($nums[$_] == $nums[$_-1] + 1) ? $printy[$_] : $printy[$_] .= ' *';
}
(1..$#printy);
unshift #res, $printy[0];
Not as clean but clear.
All this does extra work when compared to a straight loop, of course.
I'm sorry, but your code is a shambles, and you need to do much more than use map to clean up this code
You have no indentation and multiple statements on a single line, and you haven't thought through your logic. Your code is unmaintainable
Here's how I would write this. It builds a parallel array of IDs, and then sorts a list of indices so that both the IDs and the original data are in order
If it makes you happier, it does include map
use strict;
use warnings 'all';
my #data = ( '1 -> this', '5 -> that', '3 -> the other', '6 -> thus and such' );
my #ids = map { /(\d+)/ } #data;
my #indexes = sort { $ids[$a] <=> $ids[$b] } 0 .. $#ids;
my $last_id;
for my $i ( #indexes ) {
print $data[$i];
print ' *' if defined $last_id and $ids[$i] > $last_id + 1;
print "\n";
$last_id = $ids[$i];
}
output
1 -> this
3 -> the other *
5 -> that *
6 -> thus and such
I have a scalar that may or may not be a reference to an array. If it is a reference to an array, I would like to dereference it and iterate over it. If not, I would like to treat it as a one-element array and iterate over that.
my $result = my_complicated_expression;
for my $value (ref($result) eq 'ARRAY' ? #$result : ($result)) {
# Do work with $value
}
Currently, I have the above code, which works fine but feels clunky and not very Perlish. Is there a more concise way to express the idea of dereferencing a value with fallback behavior if the value is not what I expect?
Just force it before the loop.
Limited, known ref type
my $result = *some function call* // [];
$result = [$result] if ref $result ne 'ARRAY';
for my $val ( #$result ){
print $val;
}
Ref type unknown
#!/usr/bin/perl
use 5.012;
use strict;
no warnings;
sub array_ref;
my $result = [qw/foo bar foobar/];
# $result = 'foo'; # scalar test case
# $result = {foo=>q{bar}}; # hash test case
$result = array_ref $result;
for my $val ( #$result ){
say $val;
}
sub array_ref {
my $ref = shift;
given(ref $ref){
$ref = [%$ref] when('HASH');
$ref = [$ref] when(['SCALAR','']);
when('ARRAY'){}
default {
die 'Did not prepare for other ref types';
}
}
return $ref;
}
This is for demo purposes (you shouldn't use given/when in production code), but shows you could easily test for the ref type and cast a new response. However, if you really don't know what type of variable your function is returning, how are you sure it's even a reference. What if it was an array or hash?
Being perl, there's going to be several answers to this with the 'right' one being a matter of taste - IMHO, an acceptable shortening involves relying on the fact that the ref function returns the empty string if the expression given it is scalar. This means you don't need the eq 'ARRAY' if you know there are only two possibilities (ie, a scalar value and an array ref).
Secondly, you can iterate over a single scalar value (producing 1 iteration, obviously), so you don't have to put the $result in parentheses in the "scalar" case.
Putting these two small simplifications togeather gives;
use v5.12;
my $result1 = "Hello World";
my $result2 = [ "Hello" , "World" ];
for my $result ($result1, $result2) {
for my $value ( ref $result ? #$result : $result) {
say $value ;
}
}
which produces;
Hello World
Hello
World
There's likely to be 'fancier' things you can do, but this seems a reasonable compromise between being terse and readable. Of course, YMMV.
I see that I'm late to this, but I can't help it. With eval and $#, and the comma operator
my $ra = [ qw(a b c) ];
my $x = 23;
my $var = $ra;
# my $var = $x; # swap comment to test the other
foreach my $el ( eval { #{$var} }, $# && $var )
{
next if $el =~ /^$/; # when #$var is good comma adds empty line
print $el, "\n";
}
Prints a b c (one per line), if we swap to my $var = $x it prints 23.
When $var has the reference, the $# is empty but the comma is still executed and this adds an empty line, thus the next in the loop. Alternatively to skipping empty lines one can filter them out
foreach my $el ( grep { !/^$/ } eval { #{$var} }, $# && $var )
This does, in addition, clean out empty lines. However, most of the time that is desirable.
sub deref {
map ref($_) eq 'ARRAY'? #$_ : ref($_) eq 'HASH'? %$_ : $_, #_
}
sub myCompExpr {
1, 2, 3, [4, 5, 6], {Hello => 'world', Answer => 42}
}
print $_ for deref myCompExpr
I have a Perl script where variables must be initialized before the script can proceed. A lengthy if statement where I check each variable is the obvious choice. But maybe there is a more elegant or concise way to check several variables.
Edit:
I don't need to check for "defined", they are always defined with an empty string, I need to check that all are non-empty.
Example:
my ($a, $b, $c) = ("", "", "");
# If-clauses for setting the variables here
if( !$a || !$b || !$c) {
print "Init failed\n";
}
I am assuming that empty means the empty string, not just any false value. That is, if 0 or "0" are ever valid values post-initialization, the currently accepted answer will give you the wrong result:
use strict; use warnings;
my ($x, $y, $z) = ('0') x 3;
# my ($x, $y, $z) = ('') x 3;
for my $var ($x, $y, $z) {
die "Not properly initialized\n" unless defined($var) and length $var;
}
Now, this is pretty useless as a validation, because, more than likely, you would like to know which variable was not properly initialized if this situation occurs.
You would be better served by keeping your configuration parameters in a hash so you can easily check which ones were properly initialized.
use strict; use warnings;
my %params = (
x => 0,
y => '',
z => undef,
);
while ( my ($k, $v) = each %params ) {
validate_nonempty($v)
or die "'$k' was not properly initialized\n";
}
sub validate_nonempty {
my ($v) = #_;
defined($v) and length $v;
}
Or, if you want to list all that were not properly initialized:
my #invalid = grep is_not_initialized($params{$_}), keys %params;
die "Not properly initialized: #invalid\n" if #invalid;
sub is_not_initialized {
my ($v) = #_;
not ( defined($v) and length $v );
}
use List::MoreUtils 'all';
say 'Yes' if (all { defined } $var1, $var2, $var3);
What do you mean by "initialized"? Have values that are not "undef"?
For a small amount of values, the straightforward if check is IMHO the most readable/maintainable.
if (!$var1 || !$var2 || !$var3) {
print "ERROR: Some are not defined!";
}
By the way, checking !$var is a possible bug in that "0" is false in Perl and thus a string initialized to "0" would fail this check. It's a lot better to use $var eq ""
Or better yet, space things out for >3 values
if (!$var1 # Use this if your values are guarantee not to be "0"
|| $var2 eq "" # This is a LOT better since !$var fails on "0" value
|| $var3 eq "") {
print "ERROR: Some are not defined!";
}
If there are so many values to check that the above becomes hard to read (though with per-line check as in the second example, it doesn't really ever happen), or if the values are stored in an array, you can use grep to abstract away the checking:
# We use "length" check instead of "$_ eq ''" as per tchrist's comment below
if (grep { length } ($var1, $var2, $var3, $var4, $var5, #more_args) ) {
print "ERROR: Some are not defined!";
}
If you must know WHICH of the values are not defined, you can use for loop (left as an obvious excercise for the reader), or a map trick:
my $i = -1; # we will be pre-incrementing
if (my #undefined_indexes = map { $i++; $_ ? () : $i }
($var1, $var2, $var3, $var4, $var5, #more_args) ) {
print "ERROR: Value # $_ not defined!\n" foreach #undefined_indexes;
}
use List::Util 'first';
if (defined first { $_ ne "" } $a, $b, $c) {
warn "empty";
}
Your way is readable and easy to understand which means it's easy to maintain. Restating your boolean using de Morgan's laws:
if (not($a and $b and $c)) {
warn(qq(Not all variables are initialized!))
}
That way, you're not prefixing not in front of every variable, and it doesn't affect readability. You can use List::Util or List::MoreUtils, but they don't really add to the legibility.
As Sinan Ünür stated, if you put the variables in a hash, you could parse through the hash and then list which variables weren't initialized. This might be best if there are a lot of these variables, and the list keeps changing.
foreach my $variable qw(a b c d e f g h i j) {
if (not $param{$variable}) {
warn qq(You didn't define $variable\n);
}
}
You can use Getopts::Long to put your parameter values inside a hash instead of separate variables. Plus, the latest versions of Getopts::Long can now operate on any array and not just #ARGV.
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.