Different result in forloop? - perl

I want to print like this
xxx
xxxxx
xxxxxxx
xxxxxxxxx
xxxxxxxxxxx
I achive this by following code
$s = "x";
$z = 5;
$m = 1;
$m = $m+2,
$z--,
$c = " " x $z,
$st = $s x $m,
print "$c$st\n",
for(1..5);
My doubt
when i used increment and decrement operator after the print function it gave the different result
Script is
$c = " " x $z,
$st = $s x $m,
print "$c$st\n",
$m = $m+2,
$z--,
for(1..5);
It result is
x
35 xxx
54 xxxxx
73 xxxxxxx
92 xxxxxxxxx
Here 3 5 7 9 are printed by the $m and 5 4 3 2 are printed by the $z.
But, i not directly print the $m and $z then why it gave $m and $z value? How it is work?

The code
$c = " " x $z,
$st = $s x $m,
print "$c$st\n",
$m = $m+2,
$z--,
for(1..5);
is parsed as:
$c = " " x $z,
$st = $s x $m,
print ("$c$st\n", $m = $m+2, $z--),
for(1..5);
You can force different parsing by using parentheses:
$c = " " x $z,
$st = $s x $m,
print ("$c$st\n"),
$m = $m+2,
$z--
for(1..5);
But I rather suggest the following:
for(1..5) {
$c = " " x $z;
$st = $s x $m;
print ("$c$st\n");
$m = $m+2;
$z--;
}
That way you are not relying on any operator precedence which might bite you. You will immediately see which statements are contained in the loop too. (I had to read your initial code thrice to finally get it)

Related

Why is incorrect value of pi output?

I'm trying to calculate pi using following code that uses Chudnovsky algorithm. When $n is increased, then number of digits after the decimal point. However when $n is small, it can calculate correct value of pi (3.141592...) is output, but when $n is increased, it calculate incorrect value of pi. Why?
#!/usr/bin/perl
use strict;
use warnings;
use GMP qw(:all);
use GMP::Mpf qw(:all);
use GMP::Mpz qw(:all);
use GMP::Mpq qw(:all);
my $n = shift; $n = $n<7?7:$n;
$n *= 8;
my $l = int($n/7) + 1;
my $fmt = '%.' . $n . 'f';
my ($p0, $q0, $t0) = (1, 1, 0);
$p0 = mpz($p0);
$q0 = mpz($q0);
$t0 = mpz($t0);
my ($p, $q, $t, $a) = (0, 0, 0, 0);
$p = mpz($p);
$q = mpz($q);
$t = mpz($t);
$t = mpz($a);
for my $loop (1 .. $l){
$p = (2*$loop -1)*(6*$loop -1)*(6*$loop -5);
$q = ($loop**3)*(640320**3)/24;
$a = (-1)**$loop + (13591409 + 545140134*$loop);
$p *= $p0;
$q *= $q0;
$t = $t0*$p + $a*$p;
$p0 = $p;
$q0 = $q;
$t0 = $t;
}
my $x = sr(640320,$n);
$q = mpf($q,$n);
$t = mpf($t,$n);
my $pi = mpf(640320,$n)*sr(mpf(640320,$n),$n)*$q;
$pi /= mpf(12,$n)*($t + mpf(13591409,$n)*$q);
print $pi . "\n";
sub sr{
my ($x,$i) = #_;
my $s = mpf(0.0,$i);
my $s0 = mpf($x,$i);
for (1 .. $n){
$s = 1/$s0;
$s *= $x;
$s0 = ($s + $s0)/mpf(2.0,$i);
}
return $s;
}

Issues with arithmetic-operators

my problem is that I'm trying to put a simple math formula in a PowerShell script but this "arithmetic-operators" is an issue now for me, It was used to work this way, but something changed and now doesn't matter what I put in it multiples for more numbers as if they were letters, (it's only stacking all of them together)
I even tried fixing it using
$x=[int]$xx
to fix my variables so PowerShell could understand, and it did work just not with broken numbers Ex: 7.5 or 3.1 or 9.6 No broken numbers. Can anyone help me
$pi=[math]::pi
$xx= Read-Host -prompt "X "
$yy= Read-Host -prompt "Y "
$zz= Read-Host -prompt "Z "
$x=[int]$xx
$y=[int]$yy
$z=[int]$zz
$re = $z * $y
$r = $z * $x + $y * $x + $z * $x + $y * $x
$res = 2 * ($re) + $r
echo .
echo "$r = $z * $x + $y * $x + $z * $x + $y * $x"
echo .
echo "$re = $z * $y"
echo .
echo "$res = 2 * ($re) + $r"
echo .
echo "Total = $res"
echo .
pause
if you run this and put X as 27, Y as 7.5 and Z as 17, your answer should be 1578, and you fixed it
You are getting the wrong answer because 7.5 is not an [int]. It is rounding 7.5 to 8 to cast it to an int. You need $y=[single]$yy to make this work or any other type that supports decimals. I would replace all [int] with [single] if expect decimal values. See the following:
$pi=[math]::pi
$xx= Read-Host -prompt "X "
$yy= Read-Host -prompt "Y "
$zz= Read-Host -prompt "Z "
$x=[single]$xx
$y=[single]$yy
$z=[single]$zz
$re = $z * $y
$r = $z * $x + $y * $x + $z * $x + $y * $x
$res = 2 * ($re) + $r
echo "$r = $z * $x + $y * $x + $z * $x + $y * $x"
echo "$re = $z * $y"
echo "$res = 2 * ($re) + $r"
echo "Total = $res"
Output of the variables above:
$x,$y,$z,$re,$r,$res
27
7.5
17
127.5
1323
1578
Other types that you could potentially use are [double], which is the default type of uncasted numbers with decimals, and [decimal]. You can also use the -as type operator like $y = $yy -as [double]. See About Type Operators

PERL Script for discerning between cavity and void space in PDB(Protein Database) file

The problem with the following code is only in one function of the code. The problem function is with a comment head and close. This is my first post to StackOverflow so bear with me. The following script has some modules and other functions that I know work by testing them with the problem function commented out but I just cannot seem to get that one function to work. When ran, the script runs until the enviroment kills the execution.
Basically what this program does is takes a PDB file, copies everything out of the PDB file and creates a new one and pastes all of the original input file content into the new file and appends the cavities(coordinates of center of the cavity and the specified probe radius) that the program is supposed to find.
The problem function within the code is supposed to distinguish between a void space within a bound box of the structure and a cavity. Cavities are considered to be a closed space somewhere within the structure. A void space is any space or coordinate within the bounding box of max and min coorindates where there isn't an atom.The cavity must be large enough to fit into a specified probe radius. There is also a specified resolution when searching through the 3D hashtable of coordinates.
Can anyone tell me why my code isn't working. Anything immediate. I have tested and tested and cannot seem to find the error.
Thank you.
#!/usr/bin/perl
# Example 11-6 Extract atomic coordinates from PDB file
use strict;
use warnings;
use BeginPerlBioinfo; # see Chapter 6 about this module
#open file for printing
open(FH,">results.pdb");
open(PDB,"oneAtom.pdb");
while(<PDB>) { print FH $_; }
close(PDB);
# Read in PDB file
my #file = get_file_data('oneAtom.pdb');
# Parse the record types of the PDB file
my %recordtypes = parsePDBrecordtypes(#file);
# Extract the atoms of all chains in the protein
my %atoms = parseATOM ( $recordtypes{'ATOM'} );
#define some variables and get the atom indices stored in atom_numbers array
my #atom_numbers = sort {$a <=> $b} keys %atoms;
my $resolution = 4.;
my $lo = 1000;
my $hi = -1000;
my $p_rad = 1;
my %pass;
#set the grid boundaries
foreach my $l ( #atom_numbers ) {
for my $i (0..2) {
if ( $atoms{$l}[$i] < $lo ) { $lo = $atoms{$l}[$i]; }
if ( $atoms{$l}[$i] > $hi ) { $hi = $atoms{$l}[$i]; }
}
}
$lo = $lo - 2* $resolution;
$hi = $hi + 2* $resolution;
#compute min distance to the pdb structure from each grid point
for ( my $i = $lo ; $i <= $hi ; $i = $i + $resolution ) {
for ( my $j = $lo ; $j <= $hi ; $j = $j + $resolution ) {
for ( my $k = $lo ; $k <= $hi ; $k = $k + $resolution ) {
my $min_dist = 1000000;
foreach my $l ( #atom_numbers ) {
my $distance = sqrt((($atoms{$l}[0]-($i))*($atoms{$l}[0]-($i))) + (($atoms{$l}[1]-($j))*($atoms{$l}[1]-($j))) + (($atoms{$l}[2]-($k))*($atoms{$l}[2]-($k))));
$distance = $distance - ( $p_rad + $atoms{$l}[3] );
if ( $distance < $min_dist ) {
$min_dist = $distance;
}
}
$pass{$i}{$j}{$k} = $min_dist;
if ( $pass{$i}{$j}{$k} > 0 ) {
$pass{$i}{$j}{$k} = 1;
} else { $pass{$i}{$j}{$k} = 0;
}
}
}
}
#define a starting point on the outside of the grid and place first on list of points
#my #point = ();
my $num_cavities = 0;
#define some offsets used to compute neighbors
my %offset = (
1 => [-1*$resolution,0,0],
2 => [1*$resolution,0,0],
3 => [0,-1*$resolution,0],
4 => [0,1*$resolution,0],
5 => [0,0,-1*$resolution],
6 => [0,0,1*$resolution],
);
##########################################################
#function below with problem
##########################################################
my #point = ();
push #point,[$hi,$hi,$hi];
=pod
#do the following while there are points on the list
while ( #point ) {
foreach my $vector ( keys %offset ) { #for each offset vector
my #neighbor = (($point[0][0]+$offset{$vector}[0]),($point[0][1]+$offset{$vector}[1]),($point[0][2]+$offset{$vector}[2])); #compute neighbor point
if ( exists $pass{$neighbor[0]}{$neighbor[1]}{$neighbor[2]} ) { #see if neighbor is in the grid
if ( $pass{$neighbor[0]}{$neighbor[1]}{$neighbor[2]} == 1 ) { #if it is see if its further than the probe radius
push #point,[($point[0][0]+$offset{$vector}[0]),($point[0][1]+$offset{$vector}[1]),($point[0][2]+$offset{$vector}[2])]; #if it is push it onto the list of points
}
}
}
$pass{$point[0][0]}{$point[0][1]}{$point[0][2]} = 0; #eliminate the point just tested from the pass array
shift #point; #move to the next point in the list
}
=cut
##############################################################
# end of problem function
##############################################################
my $grid_ind = $atom_numbers[$#atom_numbers];
for ( my $i = $lo ; $i <= $hi ; $i = $i + $resolution ) {
for ( my $j = $lo ; $j <= $hi ; $j = $j + $resolution ) {
for ( my $k = $lo ; $k <= $hi ; $k = $k + $resolution ) {
if ( $pass{$i}{$j}{$k} == 1 ) {
$grid_ind = $grid_ind + 1;
my $n = sprintf("%5d",$grid_ind);
my $x = sprintf("%7.3f",$i);
my $y = sprintf("%7.3f",$j);
my $z = sprintf("%7.3f",$k);
my $w = sprintf("%6.3f",1);
my $p = sprintf("%6.3f",$p_rad);
print FH "ATOM $n MC CAV $n $x $y $z $w $p \n";
}
}
}
}
close(FH);
exit;
#do the following while there are points on the list
for ( my $i = $lo ; $i <= $hi ; $i = $i + $resolution ) {
for ( my $j = $lo ; $j <= $hi ; $j = $j + $resolution ) {
for ( my $k = $lo ; $k <= $hi ; $k = $k + $resolution ) {
if ( $pass{$i}{$j}{$k} == 1 ) {
push #point,[$i,$j,$k];
$num_cavities++;
while ( #point ) {
foreach my $vector ( keys %offset ) { #for each offset vector
my #neighbor = (($point[0][0]+$offset{$vector}[0]),($point[0][1]+$offset{$vector}[1]),($point[0][2]+$offset{$vector}[2])); #compute neighbor point
if ( exists $pass{$neighbor[0]}{$neighbor[1]}{$neighbor[2]} ) { #see if neighbor is in the grid
if ( $pass{$neighbor[0]}{$neighbor[1]}{$neighbor[2]} == 1 ) { #if it is see if its further than the probe radius
push #point,[($point[0][0]+$offset{$vector}[0]),($point[0][1]+$offset{$vector}[1]),($point[0][2]+$offset{$vector}[2])]; #if it is push it onto the list of points
}
}
}
$pass{$point[0][0]}{$point[0][1]}{$point[0][2]} = 0; #eliminate the point just tested from the pass array
shift #point; #move to the next point in the list
}
}
}
}
}
#print the results
print "\nthe structure has " . $num_cavities . " cavities.\n\n";
#print the point that are left over (these correspond to the cavities)
#for ( my $i = -10 ; $i <= 10 ; $i = $i + $resolution ) {
# for ( my $j = -10 ; $j <= 10 ; $j = $j + $resolution ) {
# for ( my $k = -10 ; $k <= 10 ; $k = $k + $resolution ) {
# print $i . "\t" . $j . "\t" . $k . "\t" . $pass{$i}{$j}{$k} . "\n";
# }
# }
#}
###################################################
# function
###################################################
sub parseATOM {
my($atomrecord) = #_;
use strict;
use warnings;
my %results = ( );
# Turn the scalar into an array of ATOM lines
my(#atomrecord) = split(/\n/, $atomrecord);
foreach my $record (#atomrecord) {
my $number = substr($record, 6, 5); # columns 7-11
my $x = substr($record, 30, 8); # columns 31-38
my $y = substr($record, 38, 8); # columns 39-46
my $z = substr($record, 46, 8); # columns 47-54
my $r = substr($record, 60, 6); # columns 47-54
#my $element = substr($record, 76, 2); # columns 77-78
# $number and $element may have leading spaces: strip them
$number =~ s/\s*//g;
#$element =~ s/\s*//g;
$x =~ s/\s*//g;
$y =~ s/\s*//g;
$z =~ s/\s*//g;
$r =~ s/\s*//g;
# Store information in hash
#$results{$number} = [$x,$y,$z,$element];
$results{$number} = [$x,$y,$z,$r];
}
# Return the hash
return %results;
}
Here's one thing that is almost certainly slowing things down:
$x =~ s/\s*//g;
$y =~ s/\s*//g;
$z =~ s/\s*//g;
$r =~ s/\s*//g;
It is possible for \s* to match an empty string, so you are replacing empty strings with empty strings, for each empty string in the target string.
Change to:
$x =~ s/\s+//g;
$y =~ s/\s+//g;
$z =~ s/\s+//g;
$r =~ s/\s+//g;
You have the following definitions:
my $lo = 1000;
my $hi = -1000;
So when you get to your first for loop, you will set $i to 1000, and then fail the check to see if it is less than -1000.

How to use variables in a equation using Perl

I'm trying to use possible variables in a equation with Perl.
For example:
#!/usr/bin/perl -w
$a = "yellow";
$b = "orange";
$c = "col1fl0ur";
$c = $a + $b;
print "$a + $b = $c \n";
I want to be able to state the value for each variable $a, $b, $c, then be able to say that
$a + $b = "col1fl0ur"
You may ask; whats the point? just print out col1fl0ur, butI want to be able to use many more variables as well, such as in this case:
#!/usr/bin/perl -w
###values###
$a = "yellow";
$b = "orange";
$c = "col1fl0ur";
$d = "derp";
$e = "oplo";
$f = "qwerty";
###defining the equation###
$c = $a + $b;
$d = $a + $c;
$f = $d + $c;
###Printing###
print "$a + $b = $c \n";
print "$a + $c = $d \n";
print "$d + $c = $f \n";
It would help a lot if you explained your real problem, but something like this may help.
Note that you should never use $a and $b in live code as they are reserved variable names.
use strict;
use warnings;
my ($a, $b, $c, $d, $e, $f) = qw( yellow orange col1fl0ur derp oplo qwerty );
### defining the equation ###
my %sum;
$sum{$a}{$b} = $c;
$sum{$a}{$c} = $d;
$sum{$d}{$c} = $f;
### Printing ###
for my $pair ([$a, $b], [$a, $c], [$d, $c]) {
my ($p1, $p2) = #$pair;
printf "%s + %s = %s\n", $p1, $p2, $sum{$p1}{$p2};
}
output
yellow + orange = col1fl0ur
yellow + col1fl0ur = derp
derp + col1fl0ur = qwerty
If you want $b + $a to be the same as $a + $b then you will have to say so explicitly. For example,
$sum{$a}{$b} = $c;
$sum{$b}{$a} = $c;
you may use Overload pragma..
You can create a new package as follows:
package Tst;
use overload "+" => \&myadd;
sub new {
my $class = shift;
my $value = shift;
return bless \$value => $class;
}
sub myadd {
my ($x, $y) = #_;
$x = ref($x) ? $$x : $x;
$y = ref($y) ? $$y : $y;
my $value = '';
if ($x eq 'yellow' and $y eq 'orange'){
$value = 'col1fl0ur';
}
return $value;
}
1
Then in your Main program, you can do the things you like:
use Tst;
my $a = Tst->new('yellow');
my $b = Tst->new('orange');
my $c = $a + $b;
say $c;
This prints out col1fl0ur.
Rather than assigning values to Perl variables ($a, $b, $c, etc.) you might consider creating a data structure that will suit your purposes (whatever they may be!?!). Borodin's answer takes a partial step in that direction.
This example takes that idea a bit farther: the terms in your "mathematical" system would not be linked to individual Perl variables; instead they would be components of a larger data structure.
use strict;
use warnings;
my %xs = (
a => 'yellow',
b => 'orange',
c => 'col1fl0ur',
d => 'foo',
e => 'bar',
f => 'fubb',
g => 'blub',
);
$xs{'a + b'} = $xs{c};
$xs{'a * c'} = $xs{d};
$xs{'d / c'} = $xs{f};
$xs{'a + b - d + f'} = $xs{g};
printf("%15s = %s\n", $_, $xs{$_}) for sort keys %xs;
Output:
a = yellow
a * c = foo
a + b = col1fl0ur
a + b - d + f = blub
b = orange
c = col1fl0ur
d = foo
d / c = fubb
e = bar
f = fubb
g = blub

Uninitialized variable issue in Perl program

#!/usr/bin/perl
use warnings;
use Scalar::Util qw(looks_like_number);
sub term_value();
sub factor_value();
sub expression_value()
{
$num = #_;
#expression = $_[0];
print "expression[0]: " . $expression[0] . "\n";
$index = $_[$num-1];
print "index: $index\n";
$result = &term_value(#expression, $index);
$more = 1;
while($more)
{
$op = $expression[$index];
print "$op\n";
if ($op eq "+" || $op eq "-")
{
$index++;
$value = &term_value(#expression, $index);
if ($op eq '+')
{
$result = $result + $value;
} else {
$result = $result - $value;
}
}
else
{
$more = 0;
}
}
return $result;
}
sub term_value()
{
$num = #_;
#expression = $_[0];
print "expression[0]: " . $expression[0] . "\n";
$index = $_[$num-1];
print "index: $index\n";
$result = &factor_value(#expression, $index);
$more = 1;
while($more)
{
$op = $expression[$index];
if ($op eq "*" || $op eq "/")
{
$index++;
$value = &factor_value(#expression, $index);
if ($op eq '*')
{
$result = $result * $value;
} else {
$result = $result / $value;
}
} else {
$more = 0;
}
}
return $result;
}
sub factor_value()
{
$num = #_;
#expression = $_[0];
print "expression[0]: " . $expression[0] . "\n";
$index = $_[$num-1];
print "index: $index\n";
$result = 0;
$c = $expression[$index];
if ($c eq '(')
{
$index++;
$result = &expression_value(#expression, $index);
$index++;
} else {
while (looks_like_number($c))
{
$result = 10 * $result + $c - '0';
$index++;
$c = $expression[$index];
}
}
return $result;
}
#Collect argument and separate by character
#one_char = split(//, $ARGV[0]);
$index = 0;
$result = &expression_value(#one_char, $index);
print $result . "\n";
My console returns these warnings:
Use of uninitialized value $op in string eq at eval.pl line 58.
Use of uninitialized value $op in string eq at eval.pl line 58.
Use of uninitialized value $op in string eq at eval.pl line 25.
Use of uninitialized value $op in string eq at eval.pl line 25.
about the $op variable being uninitialized. I'm thinking this may be a scope problem...but I can't figure it out. I've tried everything I could think of (initializing the variable outside of the loop, etc.), but none of it seems to make a difference when running the program. Any suggestions would be greatly appreciated!
You're only using package (~global) variables, which is a huge problem given that you are using recursive functions! Start by adding
use strict;
Primarily, this will identify the variables you haven't declared. Use my to declare them in the appropriate scope.
You're trying to pass arrays to the subs, but you're failing. The only thing that can be passed to a sub is a list of scalars. If you want to pass an array to a sub, you'll need to pass a reference (~pointer) to the array.
sub foo {
my ($expressions, $index) = #_;
print($expressions->[$index], "\n");
}
foo(\#expressions, $index);
This is the reason you're getting the warnings. You are assigning one element to an array (#expression = $_[0]), then you try to index the second or later element.
By using prototype (), you're telling Perl the sub takes no arguments. Then you use & to tell Perl to ignore the prototype so you can pass arguments to your subs. Get rid of both the () after the sub names and & before sub calls.
my $more = 1;
while ($more) {
...
if (cond) {
...
} else {
$more = 0;
}
}
can be reduced to
while (1) {
...
last if !cond;
...
}
Higher Order Perl has a chapter on parsing. See section 8.1.2 for how you would build an expression parser and evaluator from scratch.
You can also take a look at the demo calculator script provided with Parse::RecDescent.
Just out of curiosity, I wanted to see what can be achieved without using parsers. The following script makes a lot of assumptions, but "works" for the simple cases.
#!/usr/bin/env perl
use strict;
use warnings;
use Regexp::Common qw(balanced number);
die "Need expression\n" unless #ARGV;
my ($expression) = #ARGV;
my $result = evaluate_expression($expression);
printf(
"'%s' evaluated to %g\n",
$expression, $result
);
my $expected = eval $expression;
unless ($result == $expected) {
die "Wrong result, should have been '$expected'\n";
}
sub evaluate_expression {
my ($expression) = #_;
my $n = qr!$RE{num}{real}!;
my $mul = qr![*/]!;
my $add = qr![+-]!;
my $subexpr = qr!$RE{balanced}{-parens=>'()'}{-keep}!;
1 while
$expression =~ s!
$subexpr
!
my $s = $1;
$s =~ s{(?:^\()|(?:\)\z)}{}g;
evaluate_expression($s)
!gex;
1 while
$expression =~ s!($n) \s* ($mul) \s* ($n)!"$1 $2 $3"!geex;
1 while
$expression =~ s!($n) \s* ($add) \s* ($n)!"$1 $2 $3"!geex;
return $expression;
}
Output:
C:\Temp> z "((1+1)*3 +2)*5"
'((1+1)*3 +2)*5' evaluated to 40
C:\Temp> z "(1+1)*3 + 2*5"
'(1+1)*3 + 2*5' evaluated to 16
But, of course, it's fragile:
C:\Temp> z "2*3+2*5"
'2*3+2*5' evaluated to 610
Wrong result, should have been '16'
As a bit of a corollary to Sinan's answer, here is a "parser" written from the other side of the camel.
use 5.010;
use strict;
use warnings;
my #ops;
use overload map {
my $op = $_;
$op => sub {
my ($x, $y) = #_[$_[2] ? (1, 0) : (0, 1)];
bless [$x, $op, $y]
}
} #ops = qw(+ - / *);
my %ops = map {$_ => eval "sub {\$_[0] $_ \$_[1]}"} #ops;
sub eval {
my $self = shift;
return $$self[0] if #$self == 1;
my ($x, $op, $y) = map {ref eq 'main' ? $_->eval : $_} #$self;
my $ret = $ops{$op}->($x, $y);
say "$ret = $x $op $y";
$ret;
}
BEGIN {overload::constant integer => sub {bless [$_[1]]}}
eval->eval for "#ARGV";
Which when run:
$ perl eval.pl 2*3+2*5
prints:
6 = 2 * 3
10 = 2 * 5
16 = 6 + 10