I am doing one multiplication operation between two float variables. After that i need to check for numeric overflow, underflow and divide by zero errors if any.
How I can do this?
Here's a way to check for overflow (which is actually just floating point +Infinity and -Infinity):
#!perl -w
use strict;
my $x = 10 ** 200;
my $positive_overflow = $x * $x;
my $negative_overflow = -$x * $x;
print is_infinity($positive_overflow) ? 'true' : 'false';
print "\n";
print is_infinity($negative_overflow) ? 'true' : 'false';
print "\n";
sub is_infinity
{
my $x = shift;
return $x =~ /inf/i;
}
Division by zero is tricky because you can't actually perform the division in normal program scope without having it die on you. You can wrap it in eval though:
#!perl -w
use strict;
my $x = 100;
my $y = 0;
my $q = try_divide($x, $y);
print "Might be division by zero...\n" if !defined $q;
$y = 10;
$q = try_divide($x, $y);
print "$q\n";
sub try_divide
{
my $x = shift;
my $y = shift;
my $q;
eval { $q = $x / $y };
return $q;
}
If your dividend is non-zero and your quotient (result) is zero, you've had an underflow.
If your result is non-zero, underflow can be checked by finding the number closest to 1 and multiplying your non-result by it and seeing if it changes; if it was a subnormal result, it will remain unchanged, since it will lack the full range of precision a normal result would have.
my $underflow_checker;
for ( my $i = 1; 1 + $i > 1; $i /= 2 ) { $underflow_checker = 1 + $i }
...
$x = 2**-520;
$y = 2**520;
$result = $x / $y;
if ( $result == 0 && $x != 0 || $result != 0 && $result * $underflow_checker == $result ) { print "Underflow!\n" }
Related
trying to run the following code:
$combs = combinations(\#set,$k);
while (my $c = $combs->next)
{
$nrc=1;
}
Gives me "out of memory!" when I hit Ctrl+C (because its taking too long and it should not) if I pass a set from, for example, (0..450) and numbers to combine ($k) of 6. This issue does not occur with, lets say, a set of 0..45 and $k=6.
Note that the while loop seems to do nothing, in the original script it printed out the combination and incremented a counter that will hold the total number of combinations. But since I was not sure what the problem was, I decided to eliminate that.
I've read the Algorithm:Combinatorics on CPAN and it states that memory usage is minimal, so I don't know what's happening.
I am using Strawberry Perl 32bit on a Windows 10 machine.
Thanks.
--------------------- COMPLETE CODE
#!/usr/bin/perl
use List::MoreUtils "uniq";
use Algorithm::Combinatorics "combinations";
my $argc = $#ARGV+1;
my #set;
if ($argc == 0)
{
print STDERR "Valor minimo de rango: "; # range min
my $minrange = int <STDIN>;
print STDERR "Valor maximo de rango: "; #range max
my $maxrange = int <STDIN>;
#set = uniq sort { $a <=> $b }($minrange...$maxrange);
}
elsif ($argc == 1)
{
open(SETFROMFILE,"<$ARGV[0]") or die "No se puedo abrir el fichero, $!";
chomp(#set = <SETFROMFILE>);
close(SETFROMFILE);
#set = uniq sort { $a <=> $b } #set;
}
else
{
print STDERR "Uso: $0 [file]\n";
exit;
}
my $nrc = 0;
print STDERR "\n";
print STDERR "Numeros a combinar: "; # get subset
my $k = <STDIN>;
if ($k == 0) { exit; }
$combs = combinations(\#set,$k);
print STDERR "\n";
while (my $c = $combs->next)
{
print join(";",#$c) . "\n";
$nrc++;
}
print STDERR "\n";
print STDERR "numero total de combinaciones: $nrc\n";
It works for me.
use strict;
use warnings;
use Algorithm::Combinatorics qw( combinations );
sub show_mem { system('ps', '--no-heading', '-o', 'rss', $$); }
my #set = (0..450);
my $k = 6;
my $count = 0;
#show_mem();
my $combs = combinations(\#set, $k);
#show_mem();
while (my $c = $combs->next) {
++$count;
if (($count % 100_000) == 0) {
print("$count\n");
#show_mem();
}
}
Output:
784
784
100000
776
200000
784
300000
788
400000
776
500000
780
600000
784
700000
768
800000
784
900000
784
1000000
776
...
Of course, it will take forever to go through all C(451, 6) = 11,303,769,578,640 combinations! (We're talking about 251 days on my machine[1].)
(Note that 11,303,769,578,640 is too large for a 32-bit integer. Fortunately, Perl will switching to using a double-precision floating-point number, and those are large enough to hold that all numbers up to and including that one.)
By the way, if you just need the number of combinations, you can use
my $count = 1; $count *= ( #set - $_ + 1 ) / $_ for 1..$k;
How I timed it:
use Algorithm::Combinatorics qw( combinations );
use Time::HiRes qw( time );
my #set = (0..450);
my $k = 6;
my $count = 0;
my $combs = combinations(\#set, $k);
my $s = time;
while (my $c = $combs->next) {
++$count;
last if $count == 1_000_000;
}
my $e = time;
print($e-$s, "\n");
There are 11.1 trillion combinations of six items out of 450. I'm not surprised it ran out of memory!
Are there ways to get inf or -inf from eval {1/0}, eval {1/-0} instead of Illegal division by zero exception?
Out of the box? No, because it's the wrong answer. Division by zero is undefined not infinite.
You could use something like // to test if the result of your eval is undefined:
my $result = eval { 1/0 } // 'inf';
print $result;
And set a default that way. (Although in the above, 'inf' is the string; a numeric value might be more useful). There are a selection of maths libraries that give you inf type constants, like bignum bigrat bigint. Portability may be an issue though.
If you use bignum, you'll get inf out of 1/0:
use bignum;
print 1 / 0; # produces "inf"
1/-0 is still inf (I guess it's because -0 == 0).
See http://perldoc.perl.org/bignum.html.
What you really need is Data::Float:
#!/usr/bin/env perl
use strict;
use warnings;
use Carp qw( croak );
use Data::Float qw( have_infinite pos_infinity neg_infinity float_is_infinite);
have_infinite() or croak "No support for infinite float values";
my $v = -1;
my $x = 1;
my $y = 0;
my $z = eval { $x/$y };
unless (defined $z) {
$z = ($x >= 0) ? pos_infinity : neg_infinity;
}
print "$z\n";
$z = eval { $v/$y };
unless (defined $z) {
$z = ($v >= 0) ? pos_infinity : neg_infinity;
}
print "$z\n";
Output:
$ ./inf.pl
Inf
-Inf
Of course, if you are using 5.10 or later, you can do:
my $z = eval { $x/$y };
$z //= ($x >= 0) ? pos_infinity : neg_infinity;
print "$z\n";
$z = eval { $v/$y };
$z //= ($v >= 0) ? pos_infinity : neg_infinity;
print "$z\n";
Following is a code for distance of each residue from the center of mass of a protein.
use strict;
use warnings;
my $chain = 'A';
my $s1 = 0;
my $s2 = 0;
my $s3 = 0;
my $cx=0;
my $cy=0;
my $cz=0;
my #pdb;
while(<>){
my #col = split;
next unless $col[0] eq 'ATOM' and $col[4] eq $chain;
push #pdb, [#col[2,3,5,6,7,8]];
}
for (my $i=0;$i<=$#pdb;$i++){
my($a, $r, $n, $x, $y, $z) = #{$pdb[$i]};
$s1 = $s1+$x;
$cx++;
$s2 = $s2+$y;
$cy++;
$s3 = $s3+$z;
$cz++;
}
my $X = sprintf "%0.3f", $s1/$cx;
my $Y = sprintf "%0.3f", $s2/$cy;
my $Z = sprintf "%0.3f", $s3/$cz;
#distance of every atom from COM.
for my $j(0..$#pdb){
my($a1, $r1, $n1, $x1, $y1, $z1) = #{$pdb[$j]};
my $dist = sprintf "%0.3f", sqrt(($X-$x1)**2 + ($Y-$y1)**2 + ($Z-$z1)**2);
if($a1 eq 'CA'){
&rmin($dist,"\n");
}
}
sub rmin{
my #pdb1 = #_;
print #pdb1;
}
The subroutine rmin printing the distance of each residue from the COM as a column. I need to send the minimum value from the first 10 and last 10 distances into two separate variables. I have tried head and tail commands using backticks:
#res = `head -10` #pdb1
Using List::Util's min and a couple array slices should work:
use List::Util qw(min);
$smallest_of_first_ten = min #pdb1[0 .. 9];
$smallest_of_last_ten = min #pdb1[-10 .. -1];
I'm trying to implement binary search. This is my code:
#!/usr/bin/perl
#use strict;
use warnings;
#array = (1..100);
$number = <STDIN>;
$low = 0;
$high = $#array;
while($low < $high){
print "Searcing $low ---- $high \n";
$mid = $low + ($high - $low)/2;
if($array[$mid] == $number){
print "Found in index:" . $mid;
last;
}
elsif($array[$mid] < $number){
$low = $mid + 1;
}
else{
$high = $mid - 1;
}
}
But it does not work although it is a straight forward implementation (at least it would be in Java).
It seems that I get float values when dividing and can not search. If I provide as input 5 I get garbage:
5
Searcing 0 ---- 99
Searcing 0 ---- 48.5
Searcing 0 ---- 23.25
Searcing 0 ---- 10.625
Searcing 0 ---- 4.3125
Searcing 3.15625 ---- 4.3125
How can I make it use integer numbers so I can index the array?
Also if I uncomment use strict I get the following errors. What do they mean?
Global symbol "#array" requires explicit package name at D:\Development\Perl\chapter3\binarySearch.pl line 6.
Global symbol "$number" requires explicit package name at D:\Development\Perl\chapter3\binarySearch.pl line 9.
Global symbol "$low" requires explicit package name at
my $int = int 5 / 2;
print $int;
Prints 2.
Two esoteric solutions. Don't actually use these unless you are really bored or something.
use integer -- a pragma that forces Perl to treat all your numerical values as integers. It can be locally scoped so it won't ruin all the data in your program
while($low < $high){
print "Searcing $low ---- $high \n";
{
use integer;
$mid = $low + ($high - $low)/2;
}
if($array[$mid] == $number){
print "Found in index:" . $mid;
last;
}
elsif($array[$mid] < $number){
$low = $mid + 1;
}
else{
$high = $mid - 1;
}
}
Perl has some special variables $=, $-, and $% that will only hold integer values, no matter what you assign to them. Use them directly
$- = $low + ($high - $low) / 2;
if ($array[$-] == $number) { ...
or as intermediates
my $mid = $- = $low + ($high - $low) / 2;
if ($array[$mid] == $number) { ...
Using the magic variables like this is handy for code golf and irritating your co-workers, but not much else.
You should be using the function int.
Aside from that, you need to use strict; and use my to scope your variables. This will catch errors that you might miss. Just declare them like this:
my #array = (1..100);
chomp(my $number = <STDIN>);
my $low = 0;
my $high = $#array;
my $mid = int ($low + ($high - $low)/2);
You might consider using chomp too, to remove newlines from your input.
Use the good old >> 1 instead of /2.
Example:
perl -e 'BEGIN { print 5/2, " : ", 5>>1}'
Output:
2.5 : 2
And use (spare an substraction):
my $mid = ($low + $high) >> 1;
There are quite a few problems with your code.
You disabled strict.
Presumably because of the next problem.
You didn't declare any of your variables, with my or our or even use vars.
our #array = 1..100;
use vars qw'$mid $low $high';
my $number = <STDIN>
You worry too much about overflows. This isn't C.
If your number would overflow an integer, it just becomes a float.
my $mid = $low + ($high - $low)/2;
Should probably just be:
my $mid = ($high + $low)/2;
You expected an integer out of a division.
my $mid = ($high + $low)/2;
If you really want an integer just use int.
my $mid = int( ($high + $low)/2 );
You didn't remove the newline from the end of $number
chomp($number);
You have an off by one error.
while($low < $high){
Should really be
while($low <= $high){
This is really your main problem.
#! /usr/bin/env perl
use strict;
use warnings;
my #array = 1..100;
my $number = <STDIN>;
chomp $number;
my $low = 0;
my $high = $#array;
while($low <= $high){
my $mid = int( ($high + $low)/2 );
printf "Searching %2d .. (%2d) .. %2d\n", $low, $mid, $high;
if($array[$mid] == $number){
print "Found $number at index mid $mid\n";
last;
}elsif($array[$mid] < $number){
$low = $mid + 1;
}else{
$high = $mid - 1;
}
}
That's not really Perlish though.
#!/usr/bin/perl
use strict;
use warnings;
use List::MoreUtils qw'first_index';
my #array = 1..100;
my $number = <STDIN>;
chomp $number;
my $index = first_index { $_ == $number } #array;
print "Found $number at index ", $index if $index != -1;
Or more bizarrely
#! /usr/bin/env perl
use strict;
use warnings;
my #array = 1..100;
my $number = <STDIN>;
chomp $number;
my $char = join '', map chr, #array;
my $index = index $char, chr $number;
print "Found $number at index $index\n" if $index != -1;
This works with numbers up-to the lesser of UV max or (2 ** 72) - 1.
That is 18,446,744,073,709,551,615 on 64-bit builds, and 4,294,967,295 on 32-bit builds.
First of all,
my $mid = $low + ($high - $low)/2
can be simplified to
my $mid = ($high + $low)/2;
You can get the integral part using int
my $mid = int( ($high + $low)/2 );
Or you could take advantage of the fact that a bit shift is an integer division by 2.
my $mid = ($high + $low) >> 1;
See also: Flexible Binary Search Function
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";
}
}