不動点演算子 DouKaku?

不動点演算子とは、関数を引数に取り、その関数の不動点を返すような関数です。つまり、不動点演算子である関数gが関数fを引数に取るとき、 f(g(f)) = g(f) となります。

お題は不動点演算子を実装することです。（Yコンビネータを実装しても結構ですが、それ以外でも、コンビネータになっていなくてもOKとします）

Squeak Smalltalk で。

| fix factMaker fact |

fix := [:f | [:g | f value: [:arg | (g value: g) value: arg]] 
    value: [:g | f value: [:arg | (g value: g) value: arg]]].

factMaker := [:myself | [:n | n < 2 ifTrue: [1] ifFalse: [n * (myself value: n - 1)]]].
fact := fix value: factMaker.

^fact value: 10   "=> 3628800 "

Scalaで。

def Y[A,B](f:((A=>B),A)=>B,x:A):B = f((x1:A)=>Y(f,x1),x)

def factMaker(self:(int)=>int, n:int) = {
  if(n < 2) { 1 }
  else{ n * self(n-1)}
}

print(Y(factMaker, 10)) //=> 3628800

Yコンビネータを愚直に実装しただけです。
    f = lambda {|g| lambda {|n| if n == 0 then 1 else n * g[n-1] end}}
    Y[f][5]  # => 120
とかやって遊びます。

Y = lambda {|f|
  g = lambda {|x| lambda {|*n| (f[x[x]])[*n]}}
  g[g]
}

#2929 に書いたものそのままですが。

OCaml は正格評価なので y f = f (y f) と書くと止まりませんが、仮引数 x を与えてやって関数本体の計算開始を遅らせれば大丈夫です。

1	let rec y f x = f (y f) x

Haskell は、まあほぼ自明なやつですが……

ついでに実行例でも:

Prelude> let y f = f $ y f
Prelude> let fib_maker f x = if x <= 2 then 1 else f (x-1) + f (x-2)
Prelude> let fib = y fib_maker
Prelude> map fib [1..10]
[1,1,2,3,5,8,13,21,34,55]

1	let y f = f $ y f

わざわざJavaで書く意味がないですね（笑）

public class FixedPointOperator {

    // 任意の関数型 T を定義します
    abstract class T {
        abstract T apply(final T arg);
    }

    // 整数型を定義します
    class Int extends T {
        int val;
        Int(int val) { this.val = val; }
        // 整数型の apply が呼ばれることはありません
        T apply(final T arg) { throw new RuntimeException(); }
    }

    // 不動点オペレータを定義します
    // Y = (g=>(s=>g (x=>(s s) x))(s=>g (x=>(s s) x)))
    //               ------------  ここを tmp2 としています
    //         ------------------- ここを tmp1 としています
    final T Y = new T() {
        T apply(final T g) {
            final T tmp1 = new T() {
                T apply(final T s) {
                    final T tmp2 = new T() {
                        T apply(final T x) {
                            return s.apply(s).apply(x);
                        }
                    };
                    return g.apply(tmp2);
                }
            };
            return tmp1.apply(tmp1);
        }
    };

    // 階乗を求める関数です (サンプル)
    // factRec = (f=>(x=>(if x = 0 then 1 else x * (f (x - 1)))))
    final T factRec = new T() {
        T apply(final T f) {
            return new T() {
                T apply(final T x) {
                    int i = ((Int) x).val;
                    if (i == 0) {
                        return new Int(1);
                    } else {
                        return new Int(i * ((Int) f.apply(new Int(i - 1))).val);
                    }
                }
            };
        }
    };

    // 不動点オペレータ Y を factRec に適用して再帰的関数を作成
    // ためしに fact(5) を計算します
    public void exec() {
        T fact = Y.apply(factRec);
        Int five = new Int(5);
        Int result = (Int) fact.apply(five);
        System.out.println("fact(" + five.val + ") = " + result.val);
    }

    public static void main(String args[]) {
        new FixedPointOperator().exec();
    }
}

括弧の拡張機能を使って #5731 と #5733 の写経。(Yコンビネータは理解してない。)

Object do( curlyBrackets  := getSlot("block"))
Block  do( squareBrackets := getSlot("call"))

Y := { f,
  { g, f[{ a, g[g][a] }] }[
  { g, f[{ a, g[g][a] }] }]
}

Y[{ b, { n, if(n < 2, 1, n * b[n - 1]) } }][10] println

Y CombinatorのApplicative Order版のZ Combinatorと、名前付きのものと双方。

詳しくは

TuringとChurchの狭間で

を参照のこと。

sub fix {
  my $G = shift; 
  return $G->( sub { my $x = shift; return fix($G)->($x);} ); 
} 

our $Z = sub { my $f = shift;
               sub { my $x = shift; 
                     sub { my $y = shift;
                           $f->($x->($x))
                     }
                 }->(sub { my $x = shift; 
                           sub { my $y = shift; 
                                 $f->($x->($x)) 
                           }
                     })
         };

let rec fix f = f (fix f)型の不動点演算子をCで実現してみました。
stdcall呼び出しの関数(引数は右から左にスタックにプッシュ、スタックの後始末は呼び出された側で実施)を渡すと、不動点(実体は遅延評価のためのThunk)を作って返します。

任意個の引数の関数に対応しています。
また、Visual C++/GCCの両方で使用可能です。

#include <stdio.h>
#include <string.h>

#ifdef __GNUC__
#ifndef __stdcall
#define __stdcall __attribute__((stdcall))
#endif
#endif

#define SET(p,a) *(void**)(p+a)

void* __stdcall fix(void *f)
{
    char *thunk = strdup("hack!\xba....\xff\xd2ZPR\xb8....\xff\xe0");
    SET(thunk,  1) = f;
    SET(thunk,  6) = fix;
    SET(thunk, 16) = f;
    return thunk;
}

typedef int (__stdcall *FUNC2)(int, int);

int __stdcall gcd_maker(FUNC2 f, int a, int b)
{
    return a % b == 0 ? b : f(b, a % b);
}

int main(int argc, char**argv)
{
    FUNC2 gcd = (FUNC2)fix(gcd_maker);

    printf("gcd(2520,3840) = %d\n",             gcd(2520,       3840));
    printf("gcd(1836311903,1134903170) = %d\n", gcd(1836311903, 1134903170));

    return 0;
}

labels で無名再帰関数作りました。

こういうのは変数と関数の名前空間が分かれてると読みにくいですね。

(defun fix (f) (labels ((g (x) (funcall (funcall f #'g) x))) #'g))

(defun fib-maker (f)
  (lambda (x) 
    (if (<= x 2) 1 (+ (funcall f (1- x)) (funcall f (- x 2))))))

(let ((fib (fix #'fib-maker)))
  (mapcar fib '(1 2 3 4 5 6 7 8 9 10)))

もしかしたらマクロの方がきれいに書けるかと思っていろいろ試してみましたが、結局 alambda みたいなものにたどり着きました。

see: Onlisp: Anaphoric Macros

言語タグを間違えたので･･･

def Y[A,B](f:((A=>B),A)=>B,x:A):B = f((x1:A)=>Y(f,x1),x)

def factMaker(self:(int)=>int, n:int) = {
  if(n < 2) { 1 }
  else{ n * self(n-1)}
}

print(Y(factMaker, 10)) //=> 3628800

以下のサイトが分かりやすかったです。
結果的に#5733さんのコードそのままになりました。

see: Y Combinator

Y = function(f)
  g = function(proc) return f(function(arg) return proc(proc)(arg) end) end
  return g(g)
end

print(Y(function(f) return function(n) if n < 2 then return 1 else return n * f(n - 1) end end end)(10))

def Y(f):
  g = lambda proc: f(lambda arg: proc(proc)(arg))
  return g(g)

print Y(lambda f: lambda n: 1 if n < 2 else n * f(n - 1))(10)

お題を出したものなので回答は控える。参考リンクだけ提示。おまいらコード書け。

http://blogs.msdn.com/wesdyer/archive/2007/02/02/anonymous-recursion-in-c.aspx http://blogs.msdn.com/madst/archive/2007/05/11/recursive-lambda-expressions.aspx

// (snip)

#5783 を Scheme で写経。

(define (fix f)
  (rec (g x) ((f g) x)))

(let ((fib (fix (lambda (f)
                  (lambda (x)
                    (if (<= x 2)
                        1
                        (+ (f (- x 1)) (f (- x 2)))))))))
  (display (map fib '(1 2 3 4 5 6 7 8 9 10)))
  (newline))

テンプレート引数の推論を使って型無しラムダっぽく。

import std.stdio;

void main() {    
    auto Y = new class {
        auto opCall(_)(_ f) {
            return (new class {
                auto opCall(_)(_ g) {
                    return new class {
                        auto opCall(_)(_ x) {
                            return f(g(g))(x);
                        }
                    };
                }
            })(new class {
                auto opCall(_)(_ g) {
                    return new class {
                        auto opCall(_)(_ x) {
                            return f(g(g))(x);
                        }
                    };
                }
            });
        };
    };
    
    auto F = new class {
        auto opCall(_)(_ f) {
            return new class {
                auto opCall(_)(_ x) {
                    if (x == 0) {
                        return cast(_)1;
                    } else {
                        return x * f(x - 1);
                    }
                }
            };
        }
    };

    auto factorial = Y(F);
    writeln("fact(5) = ", factorial(10));
    writeln("fact(5) = ", factorial(20L));
}

折角なのでBoost.MPLでやりました。Boost 1.36.0使用。 VC++ 9 SP1, VC++ 8 SP1, gcc 4.3.1 (Cygwin), gcc 3.4.4 (Cygwin付属)で確認。

うまくいかずあれこれ悩んでいましたが、#5921を見たらあっというまに出来上がりました。ありがとうございます。参考ページは自分が理解するのに役立ちました。

coutではなくprintfを使っている理由は、コンパイル時計算されて定数展開されているのをアセンブリ出力を見て確かめるときに分かりやすいからです（さすがにprintfはインライン展開されないですから）。

see: 不動点演算子 - 純粋関数型雑記帳

#include <cstdio>
#include <boost/mpl/int.hpp>
#include <boost/mpl/times.hpp>
#include <boost/mpl/plus.hpp>
#include <boost/mpl/next_prior.hpp>
#include <boost/mpl/less_equal.hpp>
#include <boost/mpl/eval_if.hpp>
#include <boost/mpl/bind.hpp>
#include <boost/mpl/less_equal.hpp>

namespace mpl = boost::mpl;

template<typename F>
struct Y
{
    struct G
    {
        template<typename P>
        struct apply
        {
            struct U
            {
                template<typename A>
                struct apply : P::template apply<P>::type::template apply<A>
                {};
            };
            typedef mpl::bind<F, U, mpl::_1> type;
        };
    };
    typedef typename G::template apply<G>::type type;
};

struct FactorialBase
{
    template<typename F, typename X>
    struct apply
    {
        struct X_Times_X_minus_1 :
            mpl::times
            <
                X,
                typename F::template apply<typename mpl::template prior<X>::type>::type
            >
        {};
        typedef typename mpl::eval_if
        <
            mpl::less_equal<X, mpl::int_<1> >,
            mpl::int_<1>,
            X_Times_X_minus_1
        >::type type;
    };
};

struct FibonacciBase
{
    template<typename F, typename X>
    struct apply
    {
        typedef typename mpl::template prior<X>::type PriorX;
        struct X_minus_2_Plus_X_minus_1 :
            mpl::plus
            <
                typename F::template apply<typename mpl::template prior<PriorX>::type>::type,
                typename F::template apply<PriorX>::type
            >
        {};
        typedef typename mpl::eval_if
        <
            mpl::less_equal<X, mpl::int_<1> >,
            X,
            X_minus_2_Plus_X_minus_1
        >::type type;
    };
};

int main()
{
    typedef Y<FactorialBase>::type Factorial;
    typedef Factorial::apply<mpl::int_<10> >::type result1;
    typedef Y<FibonacciBase>::type Fibonacci;
    typedef Fibonacci::apply<mpl::int_<10> >::type result2;
    std::printf("%d\n", result1::value);
    std::printf("%d\n", result2::value);
}

DouKaku?

不動点演算子

Posted feedbacks - Flatten

Index

Feed

Other

Link

Pathtraq