I have an input like this:
100 200 A_30:120,A_140:180,B_180:220
100 300 A_70:220,B_130:300,A_190:200,A_60:300
I want to count number of A or B in each line and also compare range of A or B in each line with the range in two first column and return the length of intersection. e.g. output for first line: A:2 A_length:40 B:1 B_length:20
while(<>){
chomp($_);
my #line = split("\t| ", $_);
my $col1 = $line[0];
my $col2 = $line[1];
my #col3 = split(",",$line[2]);
my $A=0;
my $B=0;
my $A_length=0;
my $B_length=0;
for my $i (0 .. #col3-1){
my $col3 = $col3[$i];
if ($col3 =~ /A/){
my $length=0;
$length = range ($col3,$col1,$col2);
$A_length = $A_length+$length;
$A++;
}
if ($col3 =~ /B/){
my $length=0;
$length = range ($col3,$col1,$col2);
$B_length = $B_length+$length;
$B++;
}
$i++;
}
print("#A: ",$A,"\t","length_A: ",$A_length,"\t","#B: ",$B,"\t","length_B: ",$B_length,"\n");}
sub range {
my ($col3, $col1, $col2) = ($_[0],$_[1],$_[2]);
my #sub = split(":|_", $col3);
my $sub_strt = $sub[1];
my $sub_end = $sub[2];
my $sub_length;
if (($col1 >= $sub_strt) && ($col2 >= $sub_end)){
$sub_length = ($sub_end) - ($col1);}
if (($col1 >= $sub_strt) && ($col2 >= $sub_end)){
$sub_length = ($col2) - ($col1);}
if(($col1 <= $sub_strt) && ($col2 >= $sub_end)){
$sub_length = ($sub_end) - ($sub_strt);}
if(($col1 <= $sub_strt) && ($col2 <= $sub_end)){
$sub_length = ($col2) - ($sub_strt);}
return $sub_length;
}
I FIXED IT :)
Perl already has a builtin length function, which only takes one argument. As perl is compiling your script and gets to your length function call, it doesn't know about the sub length { ... } that you have defined later in the script, so it complains that you are using the builtin length function incorrectly.
How to fix this? This is Perl, so there are many ways
name your function something else. Making a function with the same name as a Perl builtin function is usually a bad idea
Call your function with the & sigil: my $length = &length($col3,$col1,$col2); That will be enough of a hint to the compiler that your function call does not refer to the builtin function.
Qualify your function call with a package name, in this case main::length($col3,$col1,$col2) or just ::length($col3,$col1,$col2).
Note that even if Perl did know about the length function you defined (you could get Perl to know by moving the sub length { ... } definition to the top of the script, for example), the function call would still be ambiguous to the compiler, the compiler would emit a warning like
Ambiguous call resolved as CORE::length(), qualify as such or use & at ...
and your script would still fail to compile. Here CORE::length would mean that Perl is resolving the ambiguity in favor of the builtin function.
Related
Okay so for my math class we were asked to write a program that performs and prints Newton's method until the values converge and we have a root for the function. At first I thought it would be easy. It was until I just couldn't get the values derived from the first time to be used the second time. My knowledge of the language is basic. Really basic, so what you're about to see might not be pretty.
#!usr/bin/perl
use PDL;
print "First guess? (this is x0)\n";
$xorig = <>;
do {
&fx;
} until ($fex == 0);
sub fx {
if ($xn == 0) {
$x = $xorig;
}
else {
$x = $xn;
}
print "What is the coefficient (for each factor) of your function?\n";
$fcx = <STDIN>;
push #coefficient_of_x, $fcx;
print "... times x to the (enter exponent, if no exponent, enter 1. if no x, enter 0)?\n";
$fex = <STDIN>;
push #exponent_x, $fex;
chomp ($fcx, $fex, $x, $xorig);
$factor = $fcx * ($x ** $fex);
push #fx, $factor;
}
my $fx = 0;
foreach my $variable (#fx) {
$fx = $variable + $fx #THIS PROVIDES A VALUE FOR THE GIVEN F(X) WITH A GIVEN X VALUE
}
print "f($x)=$fx\n";
do {
&fprimex;
} until ($fprimeex == 0);
sub fprimex {
if ($xn == 0) {
$x = $xorig;
}
else {
$x = $xn;
}
print "What is the coefficient (for each factor) of your derivative function?\n";
$fprimecx = <STDIN>;
push #coefficient_of_fpx, $fprimecx;
print "... times x to the (enter exponent, if no exponent, enter 1. if no x, enter 0)?\n";
$fprimeex = <STDIN>;
push #exponent_fpx, $fprimeex;
chomp ($fprimecx, $fprimeex, $x, $xorig);
$factorprime = $fprimecx * ($x ** $fprimeex);
push #fprimex, $factorprime;
}
$fprimex = 0;
foreach my $variableprime (#fprimex) {
$fprimex = $variableprime + $fprimex #THIS PROVIDES A VALUE FOR THE GIVEN F'(X) WITH THAT SAME X VALUE
}
print "f'($x)=$fprimex\n";
sub x0 {
$xn = $xorig - $fx / $fprimex; #THIS IS NEWTON'S METHOD EQUATION FOR THE FIRST TIME
push #newxn, $xn;
print "xn ia $xn\n";
}
&x0;
foreach $value (#exponent_x) {
$exponent_x = $xn ** $value;
push #part1, $exponent_x;
$part1 = #part1;
}
foreach $value2 (#coefficient_of_x) {
$part2 = $value2 * #part1;
push #final1, $part2;
}
print "#part1\n";
print "#final1\n";
Essentially what it is is I first ask for the first guess. I use this value to define the coefficients and the exponents of f(x) to get a value for f(x) in terms of the given x. I do it again for f'(x). Then I perform newton's method the first time and get the new value xn. But I'm having a hard time to get values for f(xn) and f'(xn), meaning I can't get x(n+1) and can't continue newton's method. I need help.
Welcome to Perl.
I would strongly recommend the following changes to your code:
Always include use strict; and use warnings; in EVERY Perl script.
Always chomp your input from STDIN as your taking it:
chomp( my $input = <STDIN> );
Don't needlessly create subroutines, especially for one-off scripts such as this.
Instead of using the statement modifier form of do, I would recommend using an infinite while with loop control statements to exit:
while (1) {
last if COND;
}
Finally, since the coefficients of your polynomial are all associated with an exponent for X, I would recommend using a %hash for conveniently saving those values.
As demonstrated:
#!usr/bin/env perl
use strict;
use warnings;
print "Build your Polynomial:\n";
my %coefficients;
# Request each Coefficient and Exponent of the Polynomial
while (1) {
print "What is the coefficient (for each factor) of your function? (use a bare return when done)\n";
chomp( my $coef = <STDIN> );
last if $coef eq '';
print "... times x to the (enter exponent, if no exponent, enter 1. if no x, enter 0)?\n";
chomp( my $exp = <STDIN> );
$coefficients{$exp} = $coef;
}
print "\nFirst guess? (this is x0)\n";
chomp( my $x = <> );
# Newton's Method Iteration
while (1) {
my $fx = 0;
my $fpx = 0;
while ( my ( $exp, $coef ) = each %coefficients ) {
$fx += $coef * $x**$exp;
$fpx += $coef * $exp * $x**( $exp - 1 ) if $exp != 0;
}
print " f(x) = $fx\n";
print " f'(x) = $fpx\n";
die "Slope of 0 found at $x\n" if $fpx == 0;
my $new_x = $x - $fx / $fpx;
print "Newton's Method gives new value for x at $new_x\n";
if ( abs($x - $new_x) < .0001 ) {
print "Accuracy reached\n";
last;
}
$x = $new_x;
}
I am having trouble working out what you intended with your code. The main problem seems to be that don't have it clear in your head what each of your subroutines do, as fx and fprimex ask for the data as well as evaluating the function (except for summing the terms which, oddly, is done outside the subroutine). That isn't what you want at all, as the exponents and coefficients remain constant throughout a program that has to evaluate those functions many times, and you really don't want to ask for the values again each time.
Here are some pointers to getting Perl code working in general
Write your program in tiny chunks -- a line or two at a time -- and check after each addition that the program compiles and runs and produces the expected results. Writing an entire program before you even try to run it is a recipe for disaster
Always use strict and use warnings, and declare every variable with my as close as possible to the point where it is first used. You have many undeclared variables which are therefore global, and passing information between sections of code using global variables is a good way to lose yourself in your own code. It is a good rule for a subroutine to use only parameters passed to it or variables declared within it
chomp variables as soon as they are read, either from a file or from the terminal. A useful idiom to trim input strings at source is
chomp(my $input = <>)
which will ensure that there are no stray newlines anywhere in your data
That at least should get you started.
I'm in two minds about showing this. I hope it will help you, but I really don't want to drag you into parts of Perl that you're not familiar with.
It's a program that uses the Newton–Raphson method to find the root of polynomials. I've skipped the terminal input for now, and hard-coded the data. As it stands it finds the square root of 3,000 by finding the positive root of x2 - 3000.
Note that #f and #f_prime hold the coefficients of the function and its derivative backwards from the usual order, so #f is (-3000, 0, 1). The program also calculates the coefficients of the derivative function, as it is a simple thing to do and far preferable to asking the user for another set of values.
There is just one subroutine polynomial, which takes a value for x and a list of coefficients. This is used to calculate the value of both the function and its derivative for a given value of x.
The algorithm step is in the line
my $new_x = $x - polynomial($x, #f) / polynomial($x, #f_prime);
which calculates x - f(x) / f'(x) and assigns it to $new_x. Each successive estimate is printed to STDOUT until the loop exits.
Comparing floating-point values for equality is a bad idea. The precision of computer floating-point values is, obviously, limited, and a sequence will probably never converge to the point where the last two values of the sequence are equal. The best that can be done is to check whether the absolute value of the difference between the last two values is below a reasonable delta. An accuracy of 10E12 is reasonable for 32-bit floating-point numbers. I have found that the series converges to within 10E14 quite reliably, but if you find that your program hangs in an endless loop then you should increase the margin.
use strict;
use warnings;
my #f = reverse (1, 0, -3000);
my #f_prime = map { $f[$_] * $_ } 1 .. $#f;
my $x = 0.5;
print $x, "\n";
while () {
my $new_x = $x - polynomial($x, #f) / polynomial($x, #f_prime);
last if abs($new_x - $x) < $x / 1e14;
$x = $new_x;
print $x, "\n";
}
sub polynomial {
my ($x, #coeffs) = #_;
my $total = 0;
my $x_pow = 1;
for my $coeff (#coeffs) {
$total += $x_pow * $coeff;
$x_pow *= $x;
}
$total;
}
output
0.5
3000.25
1500.62495833681
751.312062703027
377.652538627869
192.798174296885
104.179243809523
66.4878834504349
55.8044433107163
54.7818016853582
54.7722565822241
54.7722557505166
I came across the following Perl subroutine get_billable_pages while chasing a bug. It takes 12 arguments.
sub get_billable_pages {
my ($dbc,
$bill_pages, $page_count, $cover_page_count,
$domain_det_page, $bill_cover_page, $virtual_page_billing,
$job, $bsj, $xqn,
$direction, $attempt,
) = #_;
my $billable_pages = 0;
if ($virtual_page_billing) {
my #row;
### Below is testing on the existence of the 11th and 12th parameters ###
if ( length($direction) && length($attempt) ) {
$dbc->xdb_execute("
SELECT convert(int, value)
FROM job_attribute_detail_atmp_tbl
WHERE job = $job
AND billing_sub_job = $bsj
AND xqn = $xqn
AND direction = '$direction'
AND attempt = $attempt
AND attribute = 1
");
}
else {
$dbc->xdb_execute("
SELECT convert(int, value)
FROM job_attribute_detail_tbl
WHERE job = $job
AND billing_sub_job = $bsj
AND xqn = $xqn
AND attribute = 1
");
}
$cnt = 0;
...;
But is sometimes called with only 10 arguments
$tmp_det = get_billable_pages(
$dbc2,
$row[6], $row[8], $row[7],
$domain_det_page, $bill_cover_page, $virtual_page_billing,
$job1, $bsj1, $row[3],
);
The function does a check on the 11th and 12th arguments.
What are the 11th and 12th arguments when the function is passed only 10 arguments?
Is it a bug to call the function with only 10 arguments because the 11th and 12th arguments end up being random values?
I am thinking this may be the source of the bug because the 12th argument had a funky value when the program failed.
I did not see another definition of the function which takes only 10 arguments.
The values are copied out of the parameter array #_ to the list of scalar variables.
If the array is shorter than the list, then the excess variables are set to undef. If the array is longer than the list, then excess array elements are ignored.
Note that the original array #_ is unmodified by the assignment. No values are created or lost, so it remains the definitive source of the actual parameters passed when the subroutine is called.
ikegami suggested that I should provide some Perl code to demonstrate the assignment of arrays to lists of scalars. Here is that Perl code, based mostly on his edit
use strict;
use warnings;
use Data::Dumper;
my $x = 44; # Make sure that we
my $y = 55; # know if they change
my #params = (8); # Make a dummy parameter array with only one value
($x, $y) = #params; # Copy as if this is were a subroutine
print Dumper $x, $y; # Let's see our parameters
print Dumper \#params; # And how the parameter array looks
output
$VAR1 = 8;
$VAR2 = undef;
$VAR1 = [ 8 ];
So both $x and $y are modified, but if there are insufficient values in the array then undef is used instead. It is as if the source array was extended indefinitely with undef elements.
Now let's look at the logic of the Perl code. undef evaluates as false for the purposes of conditional tests, but you apply the length operator like this
if ( length($direction) && length($attempt) ) { ... }
If you have use warnings in place as you should, Perl would normally produce a Use of uninitialized value warning. However length is unusual in that, if you ask for the length of an undef value (and you are running version 12 or later of Perl 5) it will just return undef instead of warning you.
Regarding "I did not see another definition of the function which takes only 10 arguments", Perl doesn't have function templates like C++ and Java - it is up to the code in the subroutine to look at what it has been passed and behave accordingly.
No, it's not a bug. The remaining arguments are "undef" and you can check for this situation
sub foo {
my ($x, $y) = #_;
print " x is undef\n" unless defined $x;
print " y is undef\n" unless defined $y;
}
foo(1);
prints
y is undef
I'm learning perl and I want to understand the logic better so I can improve in programming. I was wondering if anyone could explain it part by part. I think I have a good grasp of what's happening instead of this line $num = $val * fact($val-1); ?
#!/usr/bin/perl
use warnings;
use strict;
print "Enter in a number\n";
my $input = <>;
my $num = fact($input);
print "The factorial of $input is $num\n";
sub fact {
my $val = $_[0];
if ( $val > 1 ) {
$num = $val * fact( $val - 1 );
}
else {
$num = 1;
}
}
exit;
The first line is the shebang, which specifies which version of Perl to use.
#!/usr/bin/perl
The next two lines will help you catch mistakes in your program and make sure you are coding properly. See Why use strict and warnings?
use warnings;
use strict;
print will print the message in quotes.
print "Enter in a number\n";
The diamond operator, <>, used in this context, is the same as calling readline. It will read the input from STDIN.
my $input=<>;
The next line is calling the subroutine fact with $input as an argument.
my $num= fact($input);
Printing the result. $input and $num will be interpolated because you are using double quotes.
print "The factorial of $input is $num\n";
Finally, the part you are most interested in.
sub fact{
my $val = $_[0];
if ($val > 1) {
$num = $val * fact($val-1);
} else {
$num = 1;
}
}
The first line of this subroutine my $val = $_[0];, is setting $val equal to the value you call it with. The first time through, you call is with $input, so $val will be set to that value.
Next, we have this if else statement. Suppose you enter 5 on the command line, so $input was 5. In that case, it is greater than 1. It will execute the statement $num = $val * fact($val-1);. Seeing as the value of $val is 5, it would be the same as calling $num = 5 * fact(4);.
If we were going to continue looking at the what code is executing, you'll see that now we are calling fact(4);. Since 4 > 1 it will pass the if statement again, and then call fact(3).
Each time we are multiplying the number by that number minus one, such as $val = 5 * 4 * 3 * 2 * 1.
From perlsub
If no return is found and if the last statement is an expression, its
value is returned. If the last statement is a loop control structure
like a foreach or a while , the returned value is unspecified. The
empty sub returns the empty list.
So this is why we don't have to return $num at the end of your fact subroutine, but it may be useful to add to increase readability.
Just to break down what this is doing.
$num = 5 * fact(4);
fact(4) is equivalent to 4 * fact(3).
$num = 5 * (4 * fact(3));
fact(3) is equivalent to 3 * fact(2).
$num = 5 * (4 * (3 * fact(2)));
fact(2) is equivalent to 2 * fact(1).
$num = 5 * (4 * (3 * (2 * fact(1)));
fact(1) is equivalent to 1.
$num = 5 * (4 * (3 * (2 * 1));
Search recursion on Google for another example (did you mean recursion?).
As a wise man once said: "To understand recursion, you must first understand recursion."
Anyway - there are a bunch of algorithms that can work recursively. Factorial is one.
A factorial of 5! = 5*4*3*2*1. This makes it quite a good case for recursion, because you could also say it's 5 * 4!. This is what the code is doing. When you supply a number to the subroutine 'fact' it calculates the factorial of one number lower, then multiplies by the original number. Except when it gets a value of 1 or less.
So give your fact "3" to start off. (same applies to bigger numbers, but the example is longer!)
It sets val to '3'.
Then, because '3 > 1' it goes and gets 'fact(2)'.
which because 2 > 1, goes and runs 'fact(1)'.
which because it isn't >1, returns '1'.
which is returned to the 'fact(2)' sub, multiple by '2' (giving 2) and returned as a result
to the 'fact(3) sub, which multiplies the returned result by 3, to give 6.
Personally I find recursion is a good way to confuse anyone who's reading your code. It's suitable for problems that are implicitly recursive - such as factorials, fibonnaci sequences and directory traversals - and generally should be avoided otherwise.
The reason you're having trouble learning from that code is because it's poorly designed:
The subroutine needlessly uses a lexical variable ($num) from outside the subroutine. Don't do this!
The subroutine relies on implied return values instead of specifying return explicitly.
Fixing these issues clarifies the functionality a lot:
sub fact {
my $val = $_[0];
if ( $val > 1 ) {
return $val * fact( $val - 1 );
}
else {
return 1;
}
}
And then using a ternary to reduce more:
sub fact {
my $val = shift;
return $val > 1 ? $val * fact( $val - 1 ) : 1;
}
As for when recursion is good to use? The answer is when you need it.
The factorial is an obvious example of where recursion could be used, but it's better to avoid using it when one has a choice. This is for both readability and functional reasons:
sub fact {
my $val = shift;
my $fact = 1;
while ($val > 1) {
$fact *= $val--;
}
return $fact;
}
I am having the following Ruby program.
puts "hai"
def mult(a,b)
a * b
end
puts "hello"
def getCostAndMpg
cost = 30000 # some fancy db calls go here
mpg = 30
return cost,mpg
end
AltimaCost, AltimaMpg = getCostAndMpg
puts "AltimaCost = #{AltimaCost}, AltimaMpg = {AltimaMpg}"
I have written a perl script which will extract the functions alone in a Ruby file as follows
while (<DATA>){
print if ( /def/ .. /end/ );
}
Here the <DATA> is reading from the ruby file.
So perl prograam produces the following output.
def mult(a,b)
a * b
end
def getCostAndMpg
cost = 30000 # some fancy db calls go here
mpg = 30
return cost,mpg
end
But, if the function is having block of statements, say for example it is having an if condition testing block means then it is not working. It is taking only up to the "end" of "if" block. And it is not taking up to the "end" of the function. So kindly provide solutions for me.
Example:
def function
if x > 2
puts "x is greater than 2"
elsif x <= 2 and x!=0
puts "x is 1"
else
puts "I can't guess the number"
end #----- My code parsing only up to this
end
Thanks in Advance!
If your code is properly indented, you just want lines that start with def or end, so change your program to:
while (<DATA>){
print if ( /^def/ .. /^end/ );
}
Or run it without a program file at all - run the program from the command line, using -n to have perl treat it as a while loop reading from STDIN:
perl -n -e "print if ( /^def/ .. /^end/ );" < ruby-file.rb
I am not familiar with ruby syntax but if you can ensure good indentation all over the code, you can check based on indentation. Something similar to:
my $add = 0;
my $spaces;
while(my $str = <DATA>) {
if (! $add && $str =~ /^(\s*)def function/) {
$add = 1;
$spaces = $1;
}
if ($add) {
print $_;
$add = 0 if ($str =~ /^$spaces\S/);
}
}
Another option could be counting level of program, something like this:
my $level = 0;
while(<DATA>) {
if(/\b def \b/x .. /\b end \b/x && $level == 0) {
$level++ if /\b if \b/x; # put all statements that closes by end here
$level-- if /\b end \b/x;
print;
}
}
I am not all that familiar with ruby syntax, so you need to put all statements that are closed by end into regex with $level++.
Please note I added \b around those keywords to make sure you are matching whole word and not things like undef as start of function.
I've only seen the Perl spaceship operator (<=>) used in numeric sort routines. But it seems useful in other situations. I just can't think of a practical use.
What would be an example of when it could be used outside of a Perl sort?
This is a best practice question.
I'm writing a control system for robot Joe that wants to go to robot Mary and recharge her. They move along the integer points on the line. Joe starts at $j and can walk 1 meter in any direction per time unit. Mary stands still at $m and can't move -- she needs a good recharge! The controlling program would look like that:
while ($m != $j) {
$j += ($m <=> $j);
}
The <=> operator would be useful for a binary search algorithm. Most programing languages don't have an operator that does a three-way comparison which makes it necessary to do two comparisons per iteration. With <=> you can do just one.
sub binary_search {
my $value = shift;
my $array = shift;
my $low = 0;
my $high = $#$array;
while ($low <= $high) {
my $mid = $low + int(($high - $low) / 2);
given ($array->[$mid] <=> $value) {
when (-1) { $low = $mid + 1 }
when ( 1) { $high = $mid - 1 }
when ( 0) { return $mid }
}
}
return;
}
In any sort of comparison method. For example, you could have a complicated object, but it still has a defined "order", so you could define a comparison function for it (which you don't have to use inside a sort method, although it would be handy):
package Foo;
# ... other stuff...
# Note: this is a class function, not a method
sub cmp
{
my $object1 = shift;
my $object2 = shift;
my $compare1 = sprintf("%04d%04d%04d", $object1->{field1}, $object1->{field2}, $object1->{field3});
my $compare2 = sprintf("%04d%04d%04d", $object2->{field1}, $object2->{field2}, $object2->{field3});
return $compare1 <=> $compare2;
}
This is a totally contrived example of course. However, in my company's source code I found nearly exactly the above, for comparing objects used for holding date and time information.
One other use I can think of is for statistical analysis -- if a value is repeatedly run against a list of values, you can tell if the value is higher or lower than the set's arithmetic median:
use List::Util qw(sum);
# $result will be
# -1 if value is lower than the median of #setOfValues,
# 1 if value is higher than the median of #setOfValues,
# 0 if value is equal to the median
my $result = sum(map { $value <=> $_ } #setOfValues);
Here's one more, from Wikipedia: "If the two arguments cannot be compared (e.g. one of them is NaN), the operator returns undef.", i.e., you can determine if two numbers are a a number at once, although personally I'd go for the less cryptic Scalar::Util::looks_like_number.