"Odd number of elements in hash assignment" - simple example code included, why does it happen? - perl

Basically when I shift a hash to work with it in a subroutine I get the error: Odd number of elements in hash assignment. Am I supposed to use a hash reference instead if I wish to pass hashes to subroutines?
#!/usr/bin/perl -w
use strict;
my ($a, $b, $c, %hash) = &getVals() ;
&run($a,$b,$c,%hash) ;
sub getVals() {
$hash{"f"} = "abc" ;
$a = "A" ;
$b = "B" ;
$c = "C" ;
return ($a, $b, $c, %hash) ;
}
sub run() {
my $a = shift;
my $b = shift;
my $c = shift;
my %hash = shift; #error here
#do stuff here. . .
}

shift removes the first element from #_ and returns it. You can either use the reference, or just assign the whole list (after shifting the single elements) to the hash:
my %hash = #_;

It's impossible to pass hashes to subroutines. Subroutines can take a list of scalars as arguments. (It's also the only thing they can return.)
getVals returns 5 scalars:
A
B
C
f
abc
shift returns the first scalar in #_ after removing it. You want to assign all the remaining scalars in #_ (f and abc) to the hash, not just the first one.
sub run {
my $a = shift;
my $b = shift;
my $c = shift;
my %hash = #_;
...
}
or
sub run {
my ($a, $b, $c, %hash) = #_;
...
}

try this
#!/usr/bin/perl -w
use strict;
my ($a, $b, $c, %hash) = &getVals() ;
&run($a,$b,$c,%hash) ;
sub getVals() {
$hash{"f"} = "abc" ;
$a = "A" ;
$b = "B" ;
$c = "C" ;
return ($a, $b, $c, %hash) ;
}
sub run() {
my $a = shift;
my $b = shift;
my $c = shift;
my %hash = #_;
#.............
}

Related

Comparing multiple numerical values in Perl

Say I have a few variables, $x, $y, $z, $a, $b, $c, and I want to make sure they all have the same value.
Can I test with something like if ($x == $y == $z == $a == $b == $c) to avoid multiple binary comparisons, i.e. (if $x == $y and $x == $z and $y == $z ...)?
Is there any way I can do all the comparing with one short and simple test?
if ( grep $x != $_, $y, $z, $a, $b, $c ) {
print "not all the same\n";
}
$x == $y and $x == $z and $y == $z is equivalent to $x == $y and $x == $z due to equality being transitive. This latter one is also the optimal solution, with N-1 comparisons for N variables.
If you have an array, you can use uniq from List::MoreUtils:
use List::MoreUtils qw(uniq);
my #arr1 = qw(foo foo foo foo foo foo);
my #arr2 = qw(foo BAR foo foo foo foo);
print "arr1: ", (uniq #arr1) == 1 ? "All same" : "Different" , "\n";
print "arr2: ", (uniq #arr2) == 1 ? "All same" : "Different" , "\n";
(If you have more than several variables and don't have an array, it might be worth considering to rewrite the code...)
You can use List::MoreUtils::first_index.
#!/usr/bin/env perl
use strict;
use warnings;
use List::MoreUtils qw( first_index );
my ($x, $y, $z, $a, $b, $c) = (1) x 6;
if (are_all_same($x, $y, $z, $a, $b, $c)) {
print "They all have the same value\n";
}
$c = 3;
unless (are_all_same($x, $y, $z, $a, $b, $c)) {
print "At least one has a different value than the others\n";
}
sub are_all_same {
my $x = shift;
-1 == first_index { $x != $_ } #_;
}
Of course, there is the issue of whether having so many variables in a small scope is appropriate (are you suffering from Fortranitis?), and whether one should use a hash to avoid a problem like this in the first place.
You can also use are_all_same with a large array, and it will impose minimal additional space and time penalties.
If they are all the same, then in particular the first must be equal to all the remaining ones. So that suggests the use of List::Util::all:
use List::Util 'all';
if( all { $x == $_ } $y, $z, $a, $b, $c ) {
...
}

Perl: Change in Subroutine not printing outside of routine

So I want to change numbers that I pass into a subroutine, and then retain those numbers being changed, but it doesn't seem to work.
my $A = 0;
my $T = 0;
my $C = 0;
my $G = 0;
foreach my $bases in (keys %basereads){
count ($bases, $A, $T, $C, $G);
}
Here is my subroutine
sub count {
my $bases = shift;
my $A = shift;
my $T = shift;
my $C = shift;
my $G = shift;
for (my $i = 0; $i < length($bases); $i++){
print "$bases\t";
if (uc(substr($bases,$i,1)) eq 'A'){
$A++;
}elsif (uc(substr($bases,$i,1)) eq 'T'){
$T++;
} elsif (uc(substr($bases,$i,1)) eq 'G'){
$G++;
} elsif (uc(substr($bases,$i,1)) eq 'C'){
$C++;
} else { next; }
}
print "$A\t$C\t$T\t$G\n";
return my($bases, $A, $T, $C, $G);
}
after the subroutine, I want to stored the altered A, C, T, G into a hashmap. When I print bases and ATCG inside the subroutine, it prints, so I know the computer is running through the subroutine, but it's not saving it, and when I try to manipulate it outside the subroutine (after I've called it), it starts from zero (what I had defined the four bases as before). I'm new to Perl, so I'm a little weary of subroutines.
Could someone help?
Always include use strict; and use warnings; at the top of EVERY script.
With warnings enabled, you should've gotten the following messages:
"my" variable $bases masks earlier declaration in same scope at script.pl line ...
"my" variable $A masks earlier declaration in same scope at script.pl line ...
"my" variable $T masks earlier declaration in same scope at script.pl line ...
"my" variable $C masks earlier declaration in same scope at script.pl line ...
"my" variable $G masks earlier declaration in same scope at script.pl line ...
These are caused by the my before your return statement:
return my($bases, $A, $T, $C, $G);
Correct this by simply removing the my:
return ($bases, $A, $T, $C, $G);
And then you just need to capture your returned values
($bases, $A, $T, $C, $G) = count($bases, $A, $T, $C, $G);
Given that you're new to perl, I'm sure you won't be surprised that your code could be cleaned up further though. If one uses a hash, it makes it a lot easier to count various characters in a string, as demonstrated below:
use strict;
use warnings;
my $A = 0;
my $T = 0;
my $C = 0;
my $G = 0;
foreach my $bases (keys %basereads) {
my %counts;
for my $char (split //, $bases) {
$counts{$char}++;
}
$A += $counts{A};
$T += $counts{T};
$C += $counts{C};
$G += $counts{G};
}

Perl crypt() acting weird

I'm using the function below to create a hash for a one-time download link (Originally from perlmonks). The weird thing is I always get the same hash result.
I've been RTFMing. I made sure that the crypt() function gets the last 8 characters of $exp, and also verified the $exp indeed changes. I've also tried manually feeding the crypt() function with random values, only those worked out fine and the hash result changed.
What am I missing here?
use strict;
use CGI;
sub chash {
my $exp = $_;
my $key = 'abcd1234'; //not actual key
my $hash = crypt(substr($exp,-8,8),$key);
$hash = substr($hash, 2);
$hash =~ s/[^a-zA-Z0-9]//g; $hash = uc($hash);
return $hash;
}
my $exp = time() + 60;
my $hash = chash($exp);
my $download_url="http://script.pl?$exp-$hash";
You want to pull the first item off #_ instead of trying to read $_ in your sub.
my $exp = shift;
or
my ($exp) = #_;
or
my $exp = $_[0];
From perlsub:
Any arguments passed in show up in the array #_ . Therefore, if you called a function with two arguments, those would be stored in $_[0] and $_[1] . The array #_ is a local array, but its elements are aliases for the actual scalar parameters.
Parameters to a sub will be passed in #_ not in $_.
use strict;
use warnings ;
use CGI;
sub chash {
my ( $exp ) = #_;
my $key = 'abcd1234'; # not actual key
my $hash = crypt(substr($exp,-8,8),$key);
$hash = substr($hash, 2);
$hash =~ s/[^a-zA-Z0-9]//g;
$hash = uc($hash);
return $hash;
}
my $exp = time() + 60;
my $hash = chash($exp);
my $download_url="http://script.pl?$exp-$hash";
Using use warnings; would have hinted you to this mistake.

Can I pass arguments to the compare subroutine of sort in Perl?

I'm using sort with a customized comparison subroutine I've written:
sub special_compare {
# calc something using $a and $b
# return value
}
my #sorted = sort special_compare #list;
I know it's best use $a and $b which are automatically set, but sometimes I'd like my special_compare to get more arguments, i.e.:
sub special_compare {
my ($a, $b, #more) = #_; # or maybe 'my #more = #_;' ?
# calc something using $a, $b and #more
# return value
}
How can I do that?
Use the sort BLOCK LIST syntax, see perldoc -f sort.
If you have written the above special_compare sub, you can do, for instance:
my #sorted = sort { special_compare($a, $b, #more) } #list;
You can use closure in place of the sort subroutine:
my #more;
my $sub = sub {
# calc something using $a, $b and #more
};
my #sorted = sort $sub #list;
If you want to pass the elements to be compared in #_, set subroutine's prototype to ($$). Note: this is slower than unprototyped subroutine.

Map with Split & Trim in Perl

How do I use map with the split function to trim the constituents: $a, $b, $c and $d; of $line?
my ($a, $b, $c, $d, $e) = split(/\t/, $line);
# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
Don't use prototypes the ($) on your function unless you need them.
my ( $a, $b, $c, $d, $e ) =
map {s/^\s+|\s+$//g; $_} ## Notice the `, $_` this is common
, split(/\t/, $line, 5)
;
Don't forget in the above s/// returns the replacement count -- not $_. So, we do that explicitly.
or more simply:
my #values = map {s/^\s+|\s+$//g; $_}, split(/\t/, $line, 5), $line
map takes two inputs:
an expression or block: this would be the trim expression (you don't have to write your own -- it's on CPAN)
and a list to operate on: this should be split's output:
use String::Util 'trim';
my #values = map { trim($_) } split /\t/, $line;
This should work:
my ($a, $b, $c, $d, $e) = map {trim ($_)} (split(/\t/, $line));
By the way, it's a minor point, but you should not use $a and $b as variable names.
You can also use "foreach" here.
foreach my $i ($a, $b, $c, $d, $e) {
$i=trim($i);
}
Just for variety:
my #trimmed = grep { s/^\s*|\s*$//g } split /\t/, $line;
grep acts as a filter on lists. This is why the \s+s need to be changed to \s*s inside the regex. Forcing matches on 0 or more spaces prevents grep from filtering out items in the list that have no leading or trailing spaces.
When I trim a string, I don't often want to keep the original. It would be nice to have the abstraction of a sub but also not have to fuss with temporary values.
It turns out that we can do just this, as perlsub explains:
Any arguments passed in show up in the array #_. Therefore, if you called a function with two arguments, those would be stored in $_[0] and $_[1]. The array #_ is a local array, but its elements are aliases for the actual scalar parameters. In particular, if an element $_[0] is updated, the corresponding argument is updated (or an error occurs if it is not updatable).
In your case, trim becomes
sub trim {
for (#_) {
s/^ \s+ //x;
s/ \s+ $//x;
}
wantarray ? #_ : $_[0];
}
Remember that map and for are cousins, so with the loop in trim, you no longer need map. For example
my $line = "1\t 2\t3 \t 4 \t 5 \n";
my ($a, $b, $c, $d, $e) = split(/\t/, $line);
print "BEFORE: [", join("] [" => $a, $b, $c, $d), "]\n";
trim $a, $b, $c, $d;
print "AFTER: [", join("] [" => $a, $b, $c, $d), "]\n";
Output:
BEFORE: [1] [ 2] [3 ] [ 4 ]
AFTER: [1] [2] [3] [4]