Perl factorial subroutine not taking command line arguments - perl

I'm trying to create a simple recursive factorial function in Perl that will take a number from the command line and then return it's factorial, e.g.
>./factorial.pl 3
>6
My subroutine doesn't seem to be taking the command line arguments. However if I take the exact same code without the sub wrapper it does take the command line arguments but obviously won't work as a subroutine. Below is the code:
#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;
sub fact() {
my $number = shift or return;
return 0 if $number < 0;
my $results = 1;
while ($number--) { $results *= $number--};
return $results;
}

shift in a sub defaults to shifting from #_ (the sub's arguments); outside a sub, it defaults to shifting from #ARGV (the command line parameters).
So either call fact(shift) or explicitly say shift(#ARGV) in fact.
And get rid of the () prototype: sub fact {...

Subroutine arguments are packed in #_. Pass #ARGV to the subroutine (and get rid of the empty prototype -- do not use prototypes unless you know exactly what they do):
#!/usr/bin/env perl
use warnings; use strict;
print fact(#ARGV), "\n";
sub fact {
my ($number) = #_;
# ...
}

Your script has no main thread when you wrap the code in the subroutine. YOu need to actually call your subroutine, example follows.
The () in the function signature are unnecessary as you are only passing in one argument as per Sinan
#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;
sub fact #() are unnecessary
{
my $number = shift or return;
return 0 if $number < 0;
my $results = 1;
while ($number--) { $results *= $number--};
return $results;
}
my $number = shift;
return fact($number);

The function logfac is a very accurate function of the log(factorial).
In addition.
Usually, when people ask for the factorial function, they really want it to compute a binomial coefficient. I've been using this trick since I was a student (I am only saying that so my current employer doesn't claim it as their intellectual property).
This code is numerically very accurate and very fast. Note the hardcoded limit of 20 for the "list" version... you can crank it up a little bit or tune it for performance.. I didn't bother.
For the "exact" formula, The main idea is that when computing a binomial coefficients there are a lot of cancellations. e.g. 10!/(7!*3) -> 10*9*8/(3*2*1) . To make it numerically more stable, compute this last remnant as 10/3 * 9/2 * 8/1
When the counts are too big, I used an approximation that is better converging than the stirling series. I checked up to 1000 or so.
Just call the choose m in N by 'choose(N,m)'
#Approximation from Srinivasa Ramanujan (Ramanujan 1988)
# Much better than stirling.. when tested in R.
# copyright(c) Hugues Sicotte, 2012
# Permission to use without restriction, with no implied suitability for any purposes
# use at your own risk.
use constant PI => 4 * atan2(1, 1);
sub logfac {
my $logfac=0;
my $n=shift(#_);
if($n&lt20) {
my $fac=1;
for(my $i=1;$i&lt=$n;$i++) {$fac=$fac*$i;}
$logfac=log($fac);
} else {
$logfac=n*log(n)-n+log(n*(1+4*n*(1+2*n)))/6 +log(PI)/2;
}
return $logfac;
}
sub choose {
my $total=shift #_; # N
my $choose=shift #_; # m
if($choose==0) { # N!/(0!N!) == 1, even if N==0
return 1;
} elsif($total==$choose) {#N!/N!*0!
return 1;
}
if($choose&lt20 && $total&lt20) {
my $min=$choose <$total-$choose ? $choose : $total-$choose;
my $res=$total/$min;
while($min&gt1) {
$total--;
$min--;
$res = $res * $total/$min;
}
return $res;
} else {
return exp(logfac($total)-logfac($choose)-logfac($total-$choose));
}
}

I've got it fixed now so that it works and it handles the case where no argument is presented.
#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;
sub fact {
my $number = shift or return "Need argument!";
return 0 if $number < 0;
my $results = 1;
while ($number--) { $results *= $number--};
return $results;
}
my $number= shift;
print fact($number) . "\n";

Related

Modify variable in Perl subroutine

How do I pass a local variable to a Perl subroutine and modify it?
use strict;
use warnings;
sub modify_a
{
# ????
}
{
my $a = 5;
modify_a($a);
print "$a\n"; # want this to print 10
}
sub modify_a {
$_[0] *= 2;
}
The elements of #_ are aliases to the values passed in, so if you modify that directly, you'll change the caller's values. This can be useful sometimes, but is generally discouraged as it is usually a surprise to the caller.
A less magical approach is to pass a reference.
use strict;
use warnings;
sub modify_a
{
my ($a_ref) = #_;
$$a_ref = 10;
}
{
my $a = 5;
modify_a(\$a);
print "$a\n";
}

recursion structures in perl

In Perl code I have to call the ls function and check it if any child is there. Then I have to call the same function again otherwise perform some action.
For example
# call ls Method
sub check_ls {
$folder = $foo->ls();
$length = #listing;
if ( $length > 1 ) {
#do something
}
elsif ( $length == 1 ) {
check_ls();
}
}
==================================================
Question-2:
can anyone describe/edit my below code(And i want to know the flow of the below structure)
my $foo=cms::folder_entry->new(); #create a new object of folder_entry class
$root_entry_id =$foo->new_root_folder(folder_name=>'test_root_timestamp'); #now i call the new_root_folder and in return i got the id
my $root = folder_entry_id->new($root_entry_id); #now again create a new object through passing $root_entry_id parameter
or the below statement is the correct statement?
my #listing = $root->$foo->ls();
Please edit my Comment if i am wrong in secound Question
This is a perfectly valid approach. It's called recursion, and it's often used to traverse tree-like structures.
It's important to include a condition that will end the recursion.
However your code looks like it's not going to work. You are using global variables. You should be using lexicals declared using the my keyword inside of your function, and you need to pass in the current state into the recursion.
Consider this example of calculating factorials.
sub fac {
my $number = shift;
return 1 if $number == 1;
return $number * fac($number - 1);
}
print fac(5);
It will go all the way into the recursion down to the deepest level. Then it will calculate backwards up the recursion tree. In each call, the lexical variables will be scoped, so they don't clash or get overwritten.
Look at this rewrite with debug output.
sub fac {
my $number = shift;
print "in: $number\n";
return 1 if $number == 1;
my $return = $number * fac($number - 1);
print "out: $return\n";
return $return;
}
print fac(5);
Here is the output.
in: 5
in: 4
in: 3
in: 2
in: 1
out: 2
out: 6
out: 24
out: 120
120
If you run a Perl that is at least version 5.16, you can use the __SUB__ keyword instead of the name of your sub inside of that same sub. It returns a reference to the current subroutine. That way, you can even build recursive anonymous subs. You do need to turn it on with use feature 'current_sub' or use v5.16 though.
use feature 'current_sub';
sub fac {
my $number = shift;
print "in: $number\n";
return 1 if $number == 1;
my $return = $number * __SUB__->($number - 1);
print "out: $return\n";
return $return;
}
Also add the use strict and use warnings 'all' pragmas to your code to enforce stricter rules that will make it easier to debug your code.

Perl custom syntax for passing function arguments

I have been using perl for some time now.
I want to know how I can run the following operation in perl:
subtract(40)(20)
To get the result:
20
I think I would have to look at custom parsing techniques for Perl.
This is what I am looking at right now:
Devel::Declare
Devel::CallParser
and
http://www.perl.com/pub/2012/10/an-overview-of-lexing-and-parsing.html
Now, I am not sure what to look for or what to do.
Any help on HOW to go about this, WHAT to read would be appreciated. Please be clear.
Thank you.
I recommend trying Parse::Keyword. Parse::Keyword is really great for parsing custom syntax, as it lets you call back various parts of the Perl parser, such as parse_listexpr, parse_block, parse_fullstmt, etc (see perlapi).
It has a drawback in that if you use those to parse expressions that close over variables, these are handled badly, but this can be worked around with PadWalker.
Parse::Keyword (including PadWalker trickery) is what Kavorka uses; and that does some pretty complex stuff! Early versions of p5-mop-redux used it too.
Anyway, here's a demonstration of how your weird function could be parsed...
use v5.14;
use strict;
use warnings;
# This is the package where we define the functions...
BEGIN {
package Math::Weird;
# Set up parsing for the functions
use Parse::Keyword {
add => \&_parser,
subtract => \&_parser,
multiply => \&_parser,
divide => \&_parser,
};
# This package is an exporter of course
use parent 'Exporter::Tiny';
our #EXPORT = qw( add subtract multiply divide );
# We'll need these things from PadWalker
use PadWalker qw( closed_over set_closed_over peek_my );
sub add {
my #numbers = _grab_args(#_);
my $sum = 0;
$sum += $_ for #numbers;
return $sum;
}
sub subtract {
my #numbers = _grab_args(#_);
my $diff = shift #numbers;
$diff -= $_ for #numbers;
return $diff;
}
sub multiply {
my #numbers = _grab_args(#_);
my $product = 1;
$product *= $_ for #numbers;
return $product;
}
sub divide {
my #numbers = _grab_args(#_);
my $quotient = shift #numbers;
$quotient /= $_ for #numbers;
return $quotient;
}
sub _parser {
lex_read_space;
my #args;
while (lex_peek eq '(')
{
# read "("
lex_read(1);
lex_read_space;
# read a term within the parentheses
push #args, parse_termexpr;
lex_read_space;
# read ")"
lex_peek eq ')' or die;
lex_read(1);
lex_read_space;
}
return sub { #args };
}
# In an ideal world _grab_args would be implemented like
# this:
#
# sub _grab_args { map scalar(&$_), #_ }
#
# But because of issues with Parse::Keyword, we need
# something slightly more complex...
#
sub _grab_args {
my $caller_vars = peek_my(2);
map {
my $code = $_;
my $closed_over = closed_over($code);
$closed_over->{$_} = $caller_vars->{$_} for keys %$closed_over;
set_closed_over($code, $closed_over);
scalar $code->();
} #_;
}
# We've defined a package inline. Mark it as loaded, so
# that we can `use` it below.
$INC{'Math/Weird.pm'} = __FILE__;
};
use Math::Weird qw( add subtract multiply );
say add(2)(3); # says 5
say subtract(40)(20); # says 20
say multiply( add(2)(3) )( subtract(40)(20) ); # says 100
If you can live with the additions of a sigil and an arrow, you could curry subtract as in
my $subtract = sub {
my($x) = #_;
sub { my($y) = #_; $x - $y };
};
Call it as in
my $result = $subtract->(40)(20);
If the arrow is acceptable but not the sigil, recast subtract as
sub subtract {
my($x) = #_;
sub { my($y) = #_; $x - $y };
};
Invocation in this case looks like
my $result = subtract(40)->(20);
Please don't tack on broken syntax extensions on your program to solve a solved problem.
What you want are closures, and a technique sometimes called currying.
Currying is the job of transforming a function that takes multiple arguments into a function that is invoked multiple times with one argument each. For example, consider
sub subtract {
my ($x, $y) = #_;
return $x - $y;
}
Now we can create a subroutine that already provides the first argument:
sub subtract1 { subtract(40, #_) }
Invoking subtract1(20) now evaluates to 20.
We can use anonymous subroutines instead, which makes this more flexible:
my $subtract = sub { subtract(40, #_) };
$subtract->(20);
We don't need that variable:
sub { subtract(40, #_) }->(20); # equivalent to subtract(40, 20)
We can write subtract in a way that does this directly:
sub subtract_curried {
my $x = shift;
# don't return the result, but a subroutine that calculates the result
return sub {
my $y = shift;
return $x - $y;
};
}
Now: subtract_curried(40)->(20) – notice the arrow in between, as we are dealing with a code reference (another name for anonymous subroutine, or closures).
This style of writing functions is much more common in functional languages like Haskell or OCaml where the syntax for this is prettier. It allows very flexible combinations of functions. If you are interested in this kind of programming in Perl, you might want to read Higher-Order Perl.
#Heartache: Please forget this challenge as it makes no sense for the parser and the user.
You can think of using fn[x][y] or fn{x}{y} which are valid syntax variants - i.e. you can stack [] and {} but not lists,
or fn(x,y) or fn(x)->(y) which do look nice, are also valid and meaningful syntax variants.
But fn(x)(y) will not know in which context the second list should be used.
For fn(x)(y) the common interpretation would be fn(x); (y) => (y). It returns the 2nd list after evaluating the first call.
You may create the source code filter:
package BracketFilter;
use Filter::Util::Call;
sub import {
filter_add(sub {
my $status;
s/\)\(/, /g if ($status = filter_read()) > 0;
return $status ;
});
}
1;
And use it:
#!/usr/bin/perl
use BracketFilter;
subtract(40)(20);
sub subtract {
return $_[0] - $_[1];
}

Perl's rand() function with localtime as seed

Please look at the following piece of code:
srand(localtime);
for (my $ik = 0; $ik < 3; $ik += 1)
{
print int(rand(10)),"\n";
sleep(1);
}
I invoke the above piece of code multiple times with sufficient time(5-10 sec) in between, still the output sequence is the same.
As I have set the seed to localtime every invocation must use a different seed and perhaps generate a different sequence of three numbers, because of the time gap. Why do I get the same sequence again and again.
Note: The code is NOT in a loop, it is in a Perl file which is being executed multiple times.
The documentation says that this seed fails if multiple instances run in the same 'second' leading to the same seed - here it is not the case.
EDIT:: The solution by #simbabque does help but the randomness expected is not gained. Look at my comment on the aforementioned solution below.
Try running this with use strict and use warnings. It will give you:
Argument "Thu Jun 21 13:04:41 2012" isn't numeric in srand at ...
And right there is your problem. localtime returns a string in scalar context. Try using time instead, which returns the unix timestamp as an integer. srand needs a numerical value to work.
If you add a Data::Dumper to it you'll see that the seed with your code is always 1.
no strict; no warnings;
use Data::Dumper;
print Dumper srand(localtime);
for (my $ik = 0; $ik < 3; $ik += 1)
{
print int(rand(10)),"\n";
sleep(1);
}
Says:
$VAR1 = 1;
0
2
6
What you need is:
use strict; use warnings;
srand(time);
for (my $ik = 0; $ik < 3; $ik += 1)
{
print int(rand(10)),"\n";
sleep(1);
}
Edit:
This still is not a very good idea if you want good randomness. The doc says:
In versions of Perl prior to 5.004 the default seed was just the
current time. This isn't a particularly good seed, so many old
programs supply their own seed value (often time ^ $$ or time ^ ($$ +
($$ << 15)) ), but that isn't necessary any more.
I suggest you just omit the call to srand at all unless you actually want reproducable results (i.e. for testing).
In general, there is no reason to expect better randomness by repeatedly seeding a PRNG.
You can use the following script to check what's going on with your original question:
#!/usr/bin/env perl
use strict; use warnings;
use 5.014;
for (1 .. 3) {
my $seq = newseq(3, 5);
printf "Seed = %s\n", $seq->{seed};
my $it = $seq->{generator};
while (defined(my $r = $it->())) {
print "$r\n";
}
sleep 5;
}
sub newseq {
my ($length, $limit) = #_;
$length //= 10;
$limit //= 10;
my $seed = srand(time);
return {
seed => $seed,
generator => sub {
return unless $length-- > 0;
return rand($limit);
},
};
}
However, if you do need statistically independent generators, you can use Math::Random::MT::Auto and create individual PRNG objects:
#!/usr/bin/env perl
use strict; use warnings;
use 5.014;
use strict;
use warnings;
use Math::Random::MT::Auto qw(:!auto);
my $prng1 = Math::Random::MT::Auto->new(SOURCE => '/dev/random');
my $prng2 = Math::Random::MT::Auto->new(SOURCE => 'random_org');
say $prng1->rand();
say $prng2->irand();

Why is my for loop an illegal declaration

I created two subs one to do Fibonacci and the other to test even numbers. When I call it though it is saying my for loop in line 7 the sub Fibonacci is illegal why?
#!/usr/bin/perl
use strict;
use warnings;
my ($x,$y);
my $num = 0;
sub Fibs($start,$stop){
for ($start..$stop){
($x, $y) = ($y, $x+$y);
my $total += $y;
}
print "$total \n"
}
sub even($num){
if ($num % 2 == 0){
return $num;}
}
my $big_total = Fibs(even($num), 3999999)
Edited from suggestions below.
Clearly I am missing something. From feedback updated to new version.
#!/usr/bin/perl
use strict;
use warnings;
my ($x,$y);
my $num = 0;
sub Fibs{
my ($start, $stop) = #_ ;
for ($start..$stop){
my ($x, $y) = (0,2);
if ($x % 2 == 0){
($x, $y) = ($y, $x+$y);
my $total += $y;
}
}
my $big_total = Fibs(0, 3999999)
In addition to the missing opening braces, Perl doesn't support that kind of declaration for subroutine parameters.
Rather than
sub Fibs($start, $stop) {
...
}
you need to write something like:
sub Fibs {
my($start, $stop) = #_;
...
}
(Perl does have prototypes, but they're not really intended for declaring the types of parameters, and they don't provide names. See this article for a discussion.)
Other problems:
You should add
use strict;
use warnings;
You never use the $x and $y that you declare in the outer scope.
Your even function appears to be incomplete. It doesn't (explicitly) return a value if its argument is an odd number. What exactly is it intended to do?