Pixel Pedals of Tomakomai

北海道苫小牧市出身の初老の日常

PerlによるFreeモナドの実装

悟りを開けると話題のFreeモナドPerlで実装した。実装はこちら

Freeモナドとは?

モナドの性質の1つとして、flatten : TTX → TX (または join、またはη)によって重複する関手Tを1つに押しつぶせるという点がある。そのお陰で、TTTTTTXのようにTが複数ある型は考える必要がなく、XとTXという2つの型に限定して計算を考えることができる。が、モナドではない一般の関手Fではこの操作ができない。

じゃあこの操作を普通の関手でもできるようにしてやろうということを考えると自然とFreeモナドが構成できる。直和が定義できる圏であれば、自由モノイドを作るのと同じ要領でモナドを作ればよい。具体的には、関手を適用しない型、1回適用した型、2回適用した型、・・・*1のすべての直和をとる。つまり、TX = X + FX + FFX + FFFX + ... のような関手を作ることになる。

こうしてやると、Tを何回か適用した型はFを何回か適用した型のいずれかになるわけだが、その型はすでにTXの中に入っている。よって、TT...TX → TX のマッピング、すなわちflattenが自然と定義できる。

(今回の)perlでの実装

Haskellの実装とは違う実装にしてみた。Freeクラスに含まれる値は関手をn回(n >= 0)適用した値なので、そのnを持たせる。

my $m = Data::Monad::Free->new(2, just(just "We are free!"));

後はこれを元に愚直に実装するだけ。unit:X → TX(またはreturn、またはμ)は関手適用なしの型に埋めればいいのでn == 0で埋め込む。

sub unit {
    my ($class, @v) = @_;
    $class->new(0, @v);
}

mapはFreeクラスのnの値に合わせて、元の関手によってn回mapさせてやるだけ。

sub _map_function(&) {
    my $f = shift;
    sub {
        my $fx = shift;
        $fx->map($f);
    };
}

sub map {
    my ($self, $f) = @_;

    my $n = $self->{n};
    my $xs = $self->{values};
    $f = _map_function \&$f for 1 .. $n;

    return (ref $self)->new($n, $f->(@$xs));
}

flattenは、n回関手を適用した後にm回関手を適用する形になっているので、n+m回関手を適用した型にマッピングさせるとよい。ただし、FF...FTX のような状態だと実装の都合上間にFreeクラスを挟んでしまっているので、マッピングするときにこれを剥がしておく必要がある。

sub flatten {
    my $dup_self = shift;
    my $n = $dup_self->{n};

    my $m;
    my $unwrap = sub {
        my ($mx) = @_;

        if (defined $m) {
            die if $m != $mx->{n};
        } else {
            $m = $mx->{n};
        }

        return @{$mx->{values}};
    };
    $unwrap = map_function \&$unwrap for 1 .. $n;

    my @unwraped_values = $unwrap->(@{$dup_self->{values}});
    defined $m or die "FIXME: can't unwrap Free for this monad";

    return (ref $dup_self)->new($n + $m, @unwraped_values);
}

内側の型の情報が外側から得られないがために$mの値を得る部分が非常にきびしい実装となってしまったが、MaybeやListの関手を相手にするのであれば動く。

Perlの実装の使い方

関手さえあれば普通のモナドと同等に使える。例えば、Maybe関手(Maybeモナドだけどモナドとしての機能は使わない)を相手にするなら、以下のようなコードが書ける。

my $m = Data::Monad::Free->new(1, just 3);
$m = $m->flat_map(sub {
    my $x = shift;
    return Data::Monad::Free->new(1, just $x * 2);
});
print Dumper($m);
__END__
$VAR1 = bless( {
                 'n' => 2,
                 'values' => [
                               bless( [
                                        bless( [
                                                 6
                                               ], 'Data::Monad::Maybe' )
                                      ], 'Data::Monad::Maybe' )
                             ]
               }, 'Data::Monad::Free' );

ここで最後のダンプの結果を見るとわかるとおり、計算結果の値はMaybe関手が2回ラップされた形になる。最初に書いた通り一般の関手ではflattenによる押しつぶしが使えないため、flat_mapによる演算を繰り返す度に内部の関手によるラッピングはひたすら深くなっていく。が、型としては重複しないflatなFreeクラスとして保たれる。

Haskellの実装

Haskellの実装をコピペしたものが以下。

data Free f r = Free (f (Free f r)) | Pure r

instance (Functor f) => Monad (Free f) where
    return = Pure
    (Free x) >>= f = Free (fmap (>>= f) x)
    (Pure r) >>= f = f r

Why free monads matter

本質的には今回の実装と同じで、別段難しいものではない。ただ、Free型の直和を表すのに別名のコンストラクタFreeとPureが必要なことや*2、「n回の関手適用」を再帰を使って表現しているため、理解するのに戸惑うかもしれない。

*1:自由に関手Fを適用する

*2:今回の実装ではnの違いが直和を表している

*3:TriplesとはMonadsの旧称