Вычисление рекуррентных соотношений на Perl

Привет,
в этом посте я расскажу рецепт добавления функциональности в Перл.

Как уже стало понятно из названия, мы будем вычислять рекуррентные соотношения.
Например, формулы для вычисления факториала выглядят вот так:

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

Функциональные языки программирования позволяют определять такие функции достаточно просто, в Erlang это делается следующим образом:

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

А теперь попробуем сделать нечто похожее, что позволяло бы нам писать код вида:

#!/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);

Из примера видно, что у нас появились новые функции recurrent, arg, n и lambda. На самом деле, практическая польза есть только у recurrent, все остальные нужны лишь для получения более «красивого» кода.

Давайте напишем модуль Recurrent.pm

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 } # возвращает первый аргумент
sub n         { ''    } # возвращает пустую строку
sub lambda(&) { shift } # alias для 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';
        
        # создаем кеш и функцию $name
        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;
                
            # ищем значение в кеше, если нет то вычисляем
            defined(${*{$mem}}->{$_n})
                ?  (${*{$mem}}->{$_n})
                :  (${*{$mem}}->{$_n} =
                    defined($_mapping->{$_n})
                        ?  do { local $_ = $_n; $_mapping->{$_n}->($_n) }
                        :  do { local $_ = $_n; $_mapping->{(n)}->($_n) });
        };
    }
}

1;

Теперь, можно написать что-то вроде.

#!/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);
 

В качестве бонуса напишем левостороннюю свертку, известную как reduce или foldl

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

и посчитаем сумму чисел Фибоначчи от 1 до 100

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

Update:
появилась поддержка сокращенного синтаксиса

#!/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);