Perl recurrence calculation

Hello,
In this post I will tell you the recipe for adding functionality to Pearl.

As it became clear from the name, we will calculate the recurrence relations.
For example, the formulas for calculating factorial look like this:

 f (0) = 1
 f (n) = n * f (n-1)

Functional programming languages ​​allow you to define such functions quite simply; in Erlang, this is done as follows:

  factorial (0) ->
     one;
 factorial (N) ->
     N * factorial (N-1). 

')
And now let's try to do something similar, which would allow us to write code of the form:

#! / usr / bin / perl -I./lib
use strict ;
use bigint ;

use recurrent ;

recurrent fac => {
arg ( 0 ) => lambda { my ( $ n ) = @_ ; return 1 } ,
arg ( n ) => lambda { my ( $ n ) = @_ ; return $ n * fac ( $ n - 1 ) } ,
} ;

print fac ( 100 ) ;

From the example we see that we have new functions recurrent, arg, n and lambda. In fact, only recurrent has practical use, all the rest are needed only to get a more “beautiful” code.

Let's write the Recurrent.pm module

 package recurrent;
 our $ VERSION = '0.01';
 use base qw (Exporter);

 use strict;
 use Carp qw (confess);

 our @EXPORT = qw (arg n lambda recurrent);

 sub arg {shift} # returns the first argument
 sub n {''} # returns an empty string
 sub lambda (&) {shift} # alias for sub {}
 sub recurrent ($$) { 
     my ($ name, $ mapping) = @_;
     confess '$ name should be a string'
         if ref ($ name) ne '' ||  $ name! ~ / ^ \ p {XID_Start} \ p {XID_Continue} * $ /;
     confess '$ mapping should be a hash reference'
         if ref ($ mapping) ne 'HASH';
     confess 'no parametric function in recurrent relation'
         if ref ($ mapping -> {(n ())}) ne 'CODE';
     {
         no strict 'refs';
        
         # create cache and $ name function
         my $ mem = join ('::', (caller ()) [0], "RECURRENT_CACHE_ $ name");
         my $ fun = join ('::', (caller ()) [0], "$ name");
        
         * {$ mem} = {};
         * {$ fun} = sub {
             my ($ _ n, $ _mapping) = ($ # _? $ _ [1]: $ _ [0], $ mapping);
            
             confess "argument is required for $ name (n)"
                 if! defined $ _n;
                
             # look for the value in the cache, if not then we calculate
             defined ($ {* {$ mem}} -> {$ _ n})
                 ?  ($ {* {$ mem}} -> {$ _ n})
                 : ($ {* {$ mem}} -> {$ _ n} =
                     defined ($ _ mapping -> {$ _ n})
                         ?  do {local $ _ = $ _n;  $ _mapping -> {$ _ n} -> ($ _ n)}
                         : do {local $ _ = $ _n;  $ _mapping -> {(n)} -> ($ _ n)});
         };
     }
 }

 one;

Now, you can write something like.

#! / usr / bin / perl -I./lib
use strict ;
use bigint ;

use recurrent ;

# | f (0) = 0
# | f (1) = 1
# | f (n) = f (n-1) + f (n-2)
recurrent fib => {
arg ( 0 ) => lambda { my ( $ n ) = @_ ; return 0 } ,
arg ( 1 ) => lambda { my ( $ n ) = @_ ; return 1 } ,
arg ( n ) => lambda { my ( $ n ) = @_ ; return fib ( $ n - 1 ) + fib ( $ n - 2 ) } ,
} ;

print fib ( 100 ) ;

As a bonus, we write a left-handed convolution known as reduce or foldl

sub reduce ( & @ ) {
my ( $ f , $ z , @x ) = @_ ;
map {
local ( $ a , $ b ) = ( $ _ , $ z ) ;
$ z = $ f -> ( $ a , $ b ) ;
} @x ;
$ z ;
}

and calculate the sum of Fibonacci numbers from 1 to 100

 print reduce {$ a + $ b} map {fib ($ _)} 1..100;

Update:
Abbreviated syntax support has been added.

#! / usr / bin / perl -I./lib
use utf8 ;

use strict ;
use bigint ;

use recurrent ;

sub λ ( & ) { shift }
# | ƒ (0) = 0
# | ƒ (1) = 1
# | ƒ (n) = ƒ (n-1) + (n-2)
recurrent ƒ => {
( 0 ) => λ { 0 } ,
( 1 ) => λ { 1 } ,
( n ) => λ { ƒ ( $ _ - 1 ) + ƒ ( $ _ - 2 ) } ,
} ;

print ƒ ( 100 ) ;