Perl: Change in Subroutine not printing outside of routine - perl

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};
}

Related

Perl unexpected result

Imagine I have this Perl script
my $name = " foo ";
my $sn = " foosu";
trim($name, \$sn);
print "name: [$name]\n";
print "sn: [$sn]\n";
exit 0;
sub trim{
my $fref_trim = sub{
my ($ref_input) = #_;
${$ref_input} =~ s/^\s+// ;
${$ref_input} =~ s/\s+$// ;
};
foreach my $input (#_){
if (ref($input) eq "SCALAR"){
$fref_trim->($input);
} else {
$fref_trim->(\$input);
}
}
}
Result:
name: [foo]
sn: [foosu]
I would expect $name to be "[ foo ]" when printing the value after calling trim, but the sub is setting $name as I would want it. Why is this working, when it really shouldn't?
I'm not passing $name by reference and the trim sub is not returning anything. I'd expect the trim sub to create a copy of the $name value, process the copy, but then the original $name would still have the leading and trailing white spaces when printed in the main code.
I assume it is because of the alias with #_, but shouldn't the foreach my $input (#_) force the sub to copy the value and only treat the value not the alias?
I know I can simplify this sub and I used it only as an example.
Elements of #_ are aliases to the original variables. What you are observing is the difference between:
sub ltrim {
$_[0] =~ s/^\s+//;
return $_[0];
}
and
sub ltrim {
my ($s) = #_;
$s =~ s/^\s+//;
return $s;
}
Compare your code to:
#!/usr/bin/env perl
my $name = " foo ";
my $sn = " foosu";
trim($name, \$sn);
print "name: [$name]\n";
print "sn: [$sn]\n";
sub trim {
my #args = #_;
my $fref_trim = sub{
my ($ref_input) = #_;
${$ref_input} =~ s/^\s+//;
${$ref_input} =~ s/\s+\z//;
};
for my $input (#args) {
if (ref($input) eq "SCALAR") {
$fref_trim->($input);
}
else {
$fref_trim->(\$input);
}
}
}
Output:
$ ./zz.pl
name: [ foo ]
sn: [foosu]
Note also that the loop variable in for my $input ( #array ) does not create a new copy for each element of the array. See perldoc perlsyn:
The foreach loop iterates over a normal list value and sets the scalar variable VAR to be each element of the list in turn. ...
...
the foreach loop index variable is an implicit alias for each item in the list that you're looping over.
In your case, this would mean that, at each iteration $input is an alias to the corresponding element of #_ which itself is an alias to the variable that was passed in as an argument to the subroutine.
Making a copy of #_ thus prevents the variables in the calling context from being modified. Of course, you could do something like:
sub trim {
my $fref_trim = sub{
my ($ref_input) = #_;
${$ref_input} =~ s/^\s+//;
${$ref_input} =~ s/\s+\z//;
};
for my $input (#_) {
my $input_copy = $input;
if (ref($input_copy) eq "SCALAR") {
$fref_trim->($input_copy);
}
else {
$fref_trim->(\$input_copy);
}
}
}
but I find making a wholesale copy of #_ once to be clearer and more efficient assuming you do not want to be selective.
I assume it is because of the alias with #_, but shouldn't the foreach my $input (#_) force the sub to copy the value and only treat the value not the alias?
You're right that #_ contains aliases. The part that's missing is that foreach also aliases the loop variable to the current list element. Quoting perldoc perlsyn:
If any element of LIST is an lvalue, you can modify it by modifying VAR inside the loop. Conversely, if any element of LIST is NOT an lvalue, any attempt to modify that element will fail. In other words, the foreach loop index variable is an implicit alias for each item in the list that you're looping over.
So ultimately $input is an alias for $_[0], which is an alias for $name, which is why you see the changes appearing in $name.

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 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.

Perl calculator reads in numbers will not do calculation

I have a problem with my simple calculator program. It is not performing the calculation with my if statement: it goes straight to the else.
#!/usr/bin/perl
print "enter a symbol operation symbol to and two numbers to make a calculation";
chomp($input = <>);
if ($input eq '+') {
$c = $a + $b;
print $c;
}
elsif ($input eq '-') {
$c = $a - $b;
print $c;
}
elsif ($input eq '*') {
$c = $a * $b;
print $c;
}
elsif ($input eq '/') {
$c = $a / $b;
print $c;
}
elsif ($input eq '%') {
$c = $a % $b;
print $c;
}
elsif ($input eq '**') {
$c = $a**$b;
print $c;
}
elsif ($input eq 'root') {
$c = sqrt($a);
$c = sqrt($b);
print $c;
}
else {
print " you messed up" . "$input" . "$a" . "$b";
}
To start off with, you need to add strict and warnings to the top of your script
#!/usr/bin/perl
use strict;
use warnings;
That is going to alert you to a lot of syntax errors, and force you to completely rethink/refactor your code. This is a good thing though.
One obvious thing is that $a and $b are never initialized at all. And your first if is missing the dollar sign before input.
I would change the capturing of your variables to the following:
print "enter a symbol operation symbol to and two numbers to make a calculation";
chomp(my $input = <>);
my ($operation, $x, $y) = split ' ', $input.
I'd also lean away from using $a and $b as variable names, as they are special variables used by perl's sort. Once your certain that you're getting your input properly, then start working the rest of your logic.
You forgot '$' sign in the first condition before input:
if($input eq '+'){
$c = $a + $b;
print $c;
my $a = shift(#ARGV); // first argument is a
my $b = shift(#ARGV); // second argument is b
my $input = shift(#ARGV); // third argument is an operator
if($input eq '+'){...
Also, I would recommend 'use strict' and 'use warnings' at the top unless you're proficient at Perl.

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

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 = #_;
#.............
}