Comparing multiple numerical values in Perl - 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 ) {
...
}

Related

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

How do I pass a variable as first argument to a subroutine only if it is defined?

Does anyone have a better (shorter) way of writing the following logic in Perl?
Seems abit cumbersome as it is now... And i don't want to pass any excessive variables to either of the subroutines...
#!perl
use Data::Dumper;
my $var = "ok";
my $bar = 1;
my ($a, $b, $c) = (1,2,3);
if ($var eq "ok") {
if (defined $bar) {
foo1($bar, $a);
}
else {
foo1($a);
}
}
elsif ($var eq "not_ok") {
if (defined $bar) {
foo2($bar, $a, $b);
}
else {
foo2($a, $b);
}
}
else {
if (defined $bar) {
foo3($bar, $a, $b, $c);
}
else {
foo3($a, $b, $c);
}
}
sub foo1 {print Dumper #_}
sub foo2 {print Dumper #_}
sub foo3 {print Dumper #_}
use 5.010;
foo( $bar // (), $a, $b, $c );
You could use grep:
foo(grep { defined } $where, $is, $pancakes, $house);
That will filter out any undefined values in the argument list.
You haven't said anything about what your actual foo1/2/3 subs do, so this may not be appropriate to your case, but my first impulse would be to modify them so that they simply ignore the first argument if it's undef. This would then allow you to simply call foo1($bar, $a, $b, $c); without worrying about whether $bar is defined or not.
sub foo1 {
shift unless defined $_[0];
# ...do other stuff now that any leading undef has been removed
}
if ($var eq "ok") {
foo1(defined $bar ? $bar : (), $a);
}
elsif ($var eq "not_ok") {
foo2(defined $bar ? $bar : (), $a, $b);
}
else {
foo3(defined $bar ? $bar : (), $a, $b, $c);
}
You could use an array to build your argument list:
my #args = ($a);
unshift(#args, $bar) if defined $bar;
if ($var eq "ok") {
foo1(#args);
}
elsif($var eq "not_ok") {
foo2(#args, $b);
}
else {
foo3(#args, $b, $c);
}

how fast are string operations in Perl? In particular concatenation and assignment

How fast is string concatenation in Perl? Is it linear to the length of the second operand? If so, what conditions need to be met for this operation to be linear? What are the examples on non-linear concatenation time?
And what about string assignment? When and where does the actual copy of the buffer occurs?
What about other operations like substring or simple regexes?
This is really complex question and answer depends on far many factors (architecture, underlying OS, HW, Perl compilation flags, etc.)
To get an idea, you can take a look at internals of perl structures used to represent your variables. Good source is perlguts illustrated.
If you have specific implementation in mind, try benchmarking your code:
use Benchmark qw(:all);
my $a = "Some string";
my #b = map { "Some string to append " x $_ } (1..10);
cmpthese(-1, {
( map {+ "concat_$_" => sub { my $c = $a . $b[$_] } } (1..10) )
});
The thing above compares operation my $c = $a . $b for various length of second argument. From result it can be seen that for this length ranges the operation runs roughly in linear time.
I tested this myself. Concatenation is linear to the length of the second argument but assignment is always linear to the length of the string.
It looks like Perl does not count references for strings but associates a buffer with every variable (reference).
Here are some test results:
Concatenation seems to be constant and entire test is linear:
248ms my $x; $x .= "a" for 1..2_000_000
501ms my $x; $x .= "a" for 1..4_000_000
967ms my $x; $x .= "a" for 1..8_000_000
$x = $x . $y seems to be optimized and uses $x buffer in this case:
295ms my $x; $x = $x . "a" for 1..2_000_000
592ms my $x; $x = $x . "a" for 1..4_000_000
1170ms my $x; $x = $x . "a" for 1..8_000_000
Previous optimization seems to be done statically so concatenation in next test is linear to the resulting string length and entire test is quadratic:
233ms my $x; ${\$x} = ${\$x} . "a" for 1..40_000
951ms my $x; ${\$x} = ${\$x} . "a" for 1..80_000
3811ms my $x; ${\$x} = ${\$x} . "a" for 1..160_000
Copying is linear:
186ms my $x; for (1..50_000) { $x .= "a"; my $y = $x }
764ms my $x; for (1..100_000) { $x .= "a"; my $y = $x }
3029ms my $x; for (1..200_000) { $x .= "a"; my $y = $x }
Every copy is linear, reference counting is not used for strings:
545ms my $x; for (1..50_000) { $x .= "a"; my $y = $x; my $y2 = $x; my $y3 = $x }
2264ms my $x; for (1..100_000) { $x .= "a"; my $y = $x; my $y2 = $x; my $y3 = $x }
8951ms my $x; for (1..200_000) { $x .= "a"; my $y = $x; my $y2 = $x; my $y3 = $x }