Вычисление рекуррентных соотношений на 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 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(1000);

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

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

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

use strict;
use Carp qw(croak);

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

sub arg($)    { $_[0] } # возвращает первый аргумент
sub n         { ''    } # возвращает пустую строку
sub lambda(&) {         # alias для sub { } 
    return shift;
}
sub recurrent($$) { 
    my($name, $mapping) = @_;
    croak '$name should be a string'
        if ref($name) ne '';
    croak '$mapping should be a hash reference'
        if ref($mapping) ne 'HASH';
    croak '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) = ($_[0], $mapping);
            croak "argument is required for $name(n)"
                if !defined $_n;
                
            # ищем значение в кеше, если нет то вычисляем
            defined(${*{$mem}}->{$_n})
                ?  (${*{$mem}}->{$_n})
                :  (${*{$mem}}->{$_n} =
                    defined($_mapping->{$_n})
                        ?  ($_mapping->{$_n}->($_n))
                        :  ($_mapping->{(n())}->($_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(1000);

Автор: santeri

Источник