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];
}
Related
(sub {
print 1;
})();
sub {
print 1;
}();
I tried various ways, all are wrong...
(sub { ... }) will give you the pointer to the function so you must call by reference.
(sub { print "Hello world\n" })->();
The other easy method, as pointed out by Blagovest Buyukliev would be to dereference the function pointer and call that using the { } operators
&{ sub { print "Hello World" }}();
Yay, I didn't expect you folks to come up with that much possibilities. But you're right, this is perl and TIMTOWTDI: +1 for creativitiy!
But to be honest, I use hardly another form than the following:
The Basic Syntax
my $greet = sub {
my ( $name ) = #_;
print "Hello $name\n";
};
# ...
$greet->( 'asker' )
It's pretty straight forward: sub {} returns a reference to a sub routine, which you can store and pass around like any other scalar. You can than call it by dereferencing. There is also a second syntax to dereference: &{ $sub }( 'asker' ), but I personally prefer the arrow syntax, because I find it more readable and it pretty much aligns with dereferencing hashes $hash->{ $key } and arrays $array->[ $index ]. More information on references can be found in perldoc perlref.
I think the other given examples are a bit advanced, but why not have a look at them:
Goto
sub bar {goto $foo};
bar;
Rarely seen and much feared these days. But at least it's a goto &function, which is considered less harmful than it's crooked friends: goto LABEL or goto EXPRESSION ( they are deprecated since 5.12 and raise a warning ). There are actually some circumstances, when you want to use that form, because this is not a usual function call. The calling function ( bar in the given example ) will not appear in the callling stack. And you don't pass your parameters, but the current #_ will be used. Have a look at this:
use Carp qw( cluck );
my $cluck = sub {
my ( $message ) = #_;
cluck $message . "\n";
};
sub invisible {
#_ = ( 'fake' );
goto $cluck;
}
invisible( 'real' );
Output:
fake at bar.pl line 5
main::__ANON__('fake') called at bar.pl line 14
And there is no hint of an invisible function in the stack trace. More info on goto in perldoc -f goto.
Method Calls
''->$foo;
# or
undef->$foo;
If you call a method on an object, the first parameter passed to that method will be the invocant ( usually an instance or the class name ). Did i already say that TIMTOWTCallAFunction?
# this is just a normal named sub
sub ask {
my ( $name, $question ) = #_;
print "$question, $name?\n";
};
my $ask = \&ask; # lets take a reference to that sub
my $question = "What's up";
'asker'->ask( $question ); # 1: doesn't work
my $meth_name = 'ask';
'asker'->$meth_name( $question ); # 2: doesn't work either
'asker'->$ask( $question ); # 1: this works
In the snippet above are two calls, which won't work, because perl will try to find a method called ask in package asker ( actually it would work if that code was in the said package ). But the third one succeeds, because you already give perl the right method and it doesn't need to search for it. As always: more info in the perldoc I can't find any reason right now, to excuse this in production code.
Conclusion
Originally I didn't intend to write that much, but I think it's important to have the common solution at the beginning of an answer and some explanations to the unusual constructs. I admit to be kind of selfish here: Every one of us could end up maintaining someones code, who found this question and just copied the topmost example.
There is not much need in Perl to call an anonymous subroutine where it is defined. In general you can achieve any type of scoping you need with bare blocks. The one use case that comes to mind is to create an aliased array:
my $alias = sub {\#_}->(my ($x, $y, $z));
$x = $z = 0;
$y = 1;
print "#$alias"; # '0 1 0'
Otherwise, you would usually store an anonymous subroutine in a variable or data structure. The following calling styles work with both a variable and a sub {...} declaration:
dereference arrow: sub {...}->(args) or $code->(args)
dereference sigil: &{sub {...}}(args) or &$code(args)
if you have the coderef in a scalar, you can also use it as a method on regular and blessed values.
my $method = sub {...};
$obj->$method # same as $method->($obj)
$obj->$method(...) # $method->($obj, ...)
[1, 2, 3]->$method # $method->([1, 2, 3])
[1, 2, 3]->$method(...) # $method->([1, 2, 3], ...)
I'm endlessly amused by finding ways to call anonymous functions:
$foo = sub {say 1};
sub bar {goto $foo};
bar;
''->$foo; # technically a method, along with the lovely:
undef->$foo;
() = sort $foo 1,1; # if you have only two arguments
and, of course, the obvious:
&$foo();
$foo->();
You need arrow operator:
(sub { print 1;})->();
You might not even need an anonymous function if you want to run a block of code and there is zero or one input. You can use map instead.
Just for the side effect:
map { print 1 } 1;
Transform data, take care to assign to a list:
my ($data) = map { $_ * $_ } 2;
# ------------------------------------------------------
# perl: filter array using given function
# ------------------------------------------------------
sub filter {
my ($arr1, $func) = #_;
my #arr2=();
foreach ( #{$arr1} ) {
push ( #arr2, $_ ) if $func->( $_ );
};
return #arr2;
}
# ------------------------------------------------------
# get files from dir
# ------------------------------------------------------
sub getFiles{
my ($p) = #_;
opendir my $dir, $p or die "Cannot open directory: $!";
my #files=readdir $dir;
closedir $dir;
#return files and directories that not ignored but not links
return filter \#files, (sub { my $f = $p.(shift);return ((-f $f) || (-d $f)) && (! -l $f) } );
}
I've always been somewhat confused about the purpose and usage of anonymous subs in perl. I understand the concept, but looking for examples and explanations on the value of this practice.
To be clear:
sub foo { ... } # <--- named sub
sub { ... } # <--- anonymous sub
For example:
$ perl -e 'print sub { 1 }'
CODE(0xa4ab6c)
Tells me that sub returns a scalar value. So, I can do:
$ perl -e '$a = sub { 1 }; print $a'
For the same output as above. This of course holds true for all scalar values, so you can load arrays or hashes with anonymous subs.
The question is, how do I use these subs? Why would I want to use them?
And for a gold star, is there any problem which can only be resolved with an anonymous sub?
Anonymous subroutines can be used for all sorts of things.
Callbacks for event handling systems:
my $obj = Some::Obj->new;
$obj->on_event(sub {...});
Iterators:
sub stream {my $args = \#_; sub {shift #$args}}
my $s = stream 1, 2, 3;
say $s->(); # 1
say $s->(); # 2
Higher Order Functions:
sub apply (&#) {
my $code = shift;
$code->() for my #ret = #_;
#ret
}
my #clean = apply {s/\W+/_/g} 'some string', 'another string.';
say $clean[0]; # 'some_string'
Creating aliased arrays:
my $alias = sub {\#_}->(my $x, my $y);
$alias[0]++;
$alias[1] = 5;
say "$x $y"; # '1 5''
Dynamic programming with closures (such as creating a bunch of subroutines that only differ by a small amount):
for my $name (qw(list of names)) {
no strict 'refs';
*$name = sub {... something_with($name) ...};
}
There is no situation where an anonymous subroutine can do anything that a named subroutine can not. The my $ref = sub {...} constructor is equivalent to the following:
sub throw_away_name {...}
my $ref = \&throw_away_name;
without having to bother with deciding on a unique 'throw_away_name' for each sub.
The equivalence also goes the other way, with sub name {...} being equivalent to:
BEGIN {*name = sub {...}}
So other than the name, the code reference created by either method is the same.
To call a subroutine reference, you can use any of the following:
$code->(); # calls with no args
$code->(1, 2, 3); # calls with args (1, 2, 3)
&$code(); # calls with no args
&$code; # calls with whatever #_ currently is
You can even use code references as methods on blessed or unblessed scalars:
my $list = sub {#{ $_[0] }};
say for [1 .. 10]->$list # which prints 1 .. 10
You can use it to create iterators.
use strict;
use warnings;
use 5.012;
sub fib_it {
my ($m, $n) = (0, 0);
return sub {
my $val = ( $m + $n );
$val = 1 unless $val;
($m, $n) = ($n, $val);
return $val;
}
}
my $fibber = fib_it;
say $fibber->() for (1..3); ### 1 1 2
my $fibber2 = fib_it;
say $fibber2->() for (1..5); ### 1 1 2 3 5
say $fibber->() for (1..3); #### 3 5 8
Anonymous subroutines can be used to create closures.
Closure is a notion out of the Lisp world that says if you define an anonymous function in a particular lexical context, it pretends to run in that context even when it's called outside the context.
perlref
What's a closure?
Here's something similar you might have seen before:
#new_list = map { $_ + 1 } #old_list;
And also:
#sorted = sort { $a <=> $b } #unsorted;
Neither of those are anonymous subs, but their behavior can be imitated in your functions with anonymous subs. They don't need the sub keyword because the functions are (essentially) prototyped to have their first argument be a subroutine, and Perl recognizes that as a special case where sub can be left off. (The functions also set the requisite variables to meaningful values before calling the subroutines you provided in order to simplify argument passing, but that's not related.)
You can write your own map-like function:
sub mapgrep (&#) { # make changes and also filter based on defined-ness
my ($func, #list) = #_;
my #new;
for my $i (#list) {
my $j = $func->($i);
push #new, $j if defined $j;
}
}
The magic to make it work with $_ is a bit much to write here - the above version only works for subs that take arguments.
Well I wrote a SAX parser for perl that is event driven. You can pass anonymous subs to the begin/end events on an element.
my $str = "<xml><row><data></data></row></xml>":
my $parser = SAXParser->new();
$parser->when('row')->begin(sub {
my ($element) = #_;
push(#rows, $row);
});
$parser->when('row')->end(sub {
## do something like serialize it or whatever
});
$parser->parse($str);
They are generally used when you want to pass a sub to another bit of code. Often this is a case of "When X happens (in third party code) do Y".
For example. When defining an attribute in Moose, you can specify the default value of that attribute using a sub. Given a class which has, as part of its definition:
has 'size' => (
is => 'ro',
default =>
sub { ( 'small', 'medium', 'large' )[ int( rand 3 ) ] },
predicate => 'has_size',
);
Whenever an instance of that class is created without an explicit size being passed, the sub will be called and the return value will be the size for that object.
If we switch to another language to give a different example, you'll find a similar concept in JavaScript.
var b = document.getElementById('my_button').
b.addEventListener('click', function (e) { alert('clicked!'); });
In your example, you haven't actually called created subroutine. Call is performed with either &$a or $a->() syntax. What you've done is that you stored a reference to subroutine in $a, then stringifyed it and printed result. Compare:
my $a = sub {1};
my $b = sub {1};
print join("\n", $a, $a->(), $b, $b->());
These are subs for the lazy programmer. You can use them for local throw-away functions and can save some typing. Instead of
sub x { ... }
my $function_ptr = \&x;
you can now use
my $function_ptr = sub { ... };
The anonymous functions are also private, and can only be accessed through the $function_ptr, so they don't have an entry in the symbol table.
Another Perl-beginner question, but strangely enough, I found no tutorial to explain me this simple problem.
I wanted, as an exercise, to write a function map that takes a function and an array, returning an array. In functional languages, this is used quite often and I heard about the sub references and how to use them.
sub map {
my $f = shift;
my #r = ();
foreach (#_) {
push(#r, &f($_));
}
return #r;
}
sub square {
my $r = shift;
return $r*$r;
}
print map(\&shift, 1, 2, 3, 4, 5);
But, for some reason, I only get the word CODE and a hex-number as an output, five times. I have then changed the call of f in map, to $$f($_) and $f->($_) but all of it had the same result.
What do I do wrong here?
perl have a builin map function. let's call it map2
use &$f to dereference $f
use join to print an array properly
sub map2 {
my $f = shift;
my #r = ();
foreach (#_) {
push(#r, &$f($_));
}
return #r;
}
sub square {
my $r = shift;
return $r*$r;
}
print join ",", map2(\&square, 1, 2, 3, 4, 5);
$ perl 1.pl
1,4,9,16,25
As mentioned in comments, Perl has a built in map function that you should use.
my #squares = map {$_ ** 2} 1 .. 5;
Rather than passing an argument, Perl's built in map sets $_ to each element, which allows you to write your square function succinctly as either {$_ * $_} or {$_ ** 2}
But Perl also gives you the ability to make custom map-like functions with a similar syntax. For example, say you wanted to write a version of map that maps over pairs of values:
sub pair_map (&#) { # the (&#) prototype here tells perl that the sub
my $code = shift; # takes a code block, and then a list, just like `map`
my #ret;
while (#_) {
push #ret, $code->(splice #_, 0, 2);
}
#ret
}
my #pairs = pair_map {\#_} 1 .. 10;
pair_map {print "$_[0]: $_[1]\n"} %hash;
But since Perl has been around a while, most utility functions have probably been written already. A search of CPAN will turn up many map-like functions that do various things.
I found that I frequently need to map over lists with various step sizes, so I wrote the mapn function in List::Gen. This is a fully developed solution, so it includes an optimization when called in void context, and falls back to Perl's own map when n == 1:
sub mapn (&$#) {
my ($sub, $n, #ret) = splice #_, 0, 2;
croak '$_[1] must be >= 1' unless $n >= 1;
return map $sub->($_) => #_ if $n == 1;
my $want = defined wantarray;
while (#_) {
local *_ = \$_[0];
if ($want) {push #ret =>
$sub->(splice #_, 0, $n)}
else {$sub->(splice #_, 0, $n)}
}
#ret
}
Both pair_map and mapn utilize an advanced feature of Perl subroutines called prototypes. These prototypes are not argument validation tools (like in many other languages). Rather, they tell perl to interpret calls to the functions in a special way (similar to the way some other builtin functions are used). In this case, the & portion of the prototype tells perl that the first argument to these functions can be written as a bare block, just like a normal map call.
I have implemented a simple iterator in perl. I normally work with C#, and use iterators and functional programming quite frequently. So I thought it would be simple to get some basics working in perl.
Problem is, I'm getting some poor performance, I don't expect be any faster than for or foreach, but I thought someone could give me some insight in how to speed it up.
Here is the guts of my package:
package Iterator;
use strict;
#Constructor for Iterator type
sub new {
my $type = $_[0];
my $this = {};
#set default values
$this->{Array} = #_[1];
$this->{Index} = 0;
$this->{Sub} = sub {
my #array = #{$this->{Array}};
return $#array >= $this->{Index} ? $array[$this->{Index}++] : undef;
};
#return self
bless($this, $type);
return $this;
}
#Iterates next
sub Next {
return $_[0]->{Sub}->();
}
Allows you to do this:
my $iterator = Iterator->new(\#array);
while (defined(my $current = $iterator->Next())) {
print $current, "\n";
}
Not flashy... yet.
Also enables some functional code like this:
my $sum = 0;
Iterator
->new(\#array)
->Where(sub { $_[0] % 2 == 0 })
->ForEach(sub { $sum += $_[0] });
Which would sum up all the even values of an array.
My bottleneck is the iteration code:
$this->{Sub} = sub {
my #array = #{$this->{Array}};
return $#array >= $this->{Index} ? $array[$this->{Index}++] : undef;
};
Any pointers to speed this up?
A bit late to the game here, but since you are concerned about performance, one of the largest bottlenecks in iterator type code is that the fields of your hash based object need to be dereferenced on each access. One way to combat this is to use closures in which the fields are closed over variables, avoiding unneeded dereferencing.
In my module List::Gen which contains a fairly performant implementation of lazy lists, I wrote the utility function curse which makes closure based objects behave like normal Perl objects.
Here is a short example of your iterator class written with curse. In a simple benchmark summing 1000 numbers, this method is twice as fast as yours, even after fixing all of the inefficiencies noted in the other answers.
{package Iterator;
use List::Gen 'curse';
sub new {
my ($class, $array) = #_;
my $index = 0;
curse {
next => sub {$$array[$index++]},
index => sub :lvalue {$index},
} => $class
}
sub reset {shift->index = 0}
}
If you are really pushing for more speed, since the next method does not need to be passed anything, you could even write:
my $next = $iterator->can('next');
while (defined (my $x = $next->()) {...}
Which will give you a 30% to 40% speed boost over a normal method call.
You can read the source of List::Gen for more advanced usage of curse
You might find it useful to read a bit of Higher Order Perl.
this line:
my #array = #{$this->{Array}};
duplicates the array into #array, and I don't think you want to. Just do $#{$this->{Array}} to find the endpoint of your array.
A much more efficient version:
package Iterator;
use strict;
#Constructor for Iterator type
sub new {
my $type = shift;
my $array = shift;
my $this = {};
$this->{array} = $array;
$this->{index} = 0;
bless($this, $type);
return $this;
}
#Iterates next
sub Next {
my $this = shift;
return $this->{array}->[$this->{index}++];
}
Summing even numbers is easier done using grep and List::Util:
use List::Util 'sum';
say sum grep { not $_ % 2 } (1 .. 10); // 30
It seems very likely to me that that the code suggested by your question is over-engineering. Unless you can come up with a decent example that cannot be easily solved using the traditional Perl primitives.
Have a look at List::Util and List::MoreUtils for utilities that may help you with this.
You can even use perl5i for a more modern looking syntax.
Example:
use perl5i::2;
my #nums = (0..100);
my $sumEven = #nums->grep(sub { $_ % 2 == 0 })->reduce(sub { $a+$b });
say $sumEven;
There is already an array iterator in CPAN, so you can look at its approach if you have not done it yet.
By the way in your code you have:
#set default values
$this->{Array} = #_[1];
I assume you want to say $_[1]. With #_[1] you are requesting an array slice of one element. At the end the result is the same but the semantics isn't. The curious thing is that I was expecting to have an array of one element if I do #_[1] or an error but tested in the debugger and you obtain the scalar (at least in perl 5.10). Perl 6 will go for this behaviour anyway and will not change sigil for accessing elements in arrays or hashes so you are coding 'advanced' Perl ;-)
Don't unload the stored array. You're copying every element of an array from where it is pointed at by $this->{Array} to the local list #array when you do this:
my #array = #{$this->{Array}};
Also if you know that you are going to stop when you hit undef, then you don't have to even check bounds.
$this->{Sub} = sub { return $this->{Array}[++$this->{Index}]; }
Is all you need. When {Index} gets out of range, it will return undef.
In addition, you can write your expression in Perl like:
$sum += $_ foreach grep { $_ % 2 == 0 } #array;
A much simpler Perl iterator:
my #array = (1, 2, 3, 4);
while (my $i = shift #array)
{
print $i . "\n";
}
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<20) {
my $fac=1;
for(my $i=1;$i<=$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<20 && $total<20) {
my $min=$choose <$total-$choose ? $choose : $total-$choose;
my $res=$total/$min;
while($min>1) {
$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";