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