メモ化された Y Combinator

メモ化は The Seasoned Schemer にも出てきますね。Y Combinator は昨日のコレを改造しました。

• vallog: Scheme 紙面プログラミング

	;; memoized Y Combinator
	(define memoized-Y
	(let ((cache (make-hash-table 'equal?))
	(gethash (cut hash-table-get <> <> #f)))
	(lambda (c)
	((lambda (f)
	(f f))
	(lambda (g)
	(c (lambda x
	(let ((val (gethash cache x)))
	(if val val
	((lambda (undef)
	(gethash cache x))
	(hash-table-put! cache x (apply (g g) x))))))))))))
	(define fib
	(lambda (f)
	(lambda (n)
	(if (< n 2) 1
	(+ (f (- n 1))(f (- n 2)))))))
	(time ((Y fib) 30))
	;(time ((Y fib) 30))
	; real 10.531
	; user 9.391
	; sys 0.922
	1346269
	(time ((memoized-Y fib) 30))
	;(time ((memoized-Y fib) 30))
	; real 0.000
	; user 0.000
	; sys 0.000
	1346269
	;(time ((memoized-Y fib) 1000))
	; real 0.047
	; user 0.031
	; sys 0.000
	70330367711422815821835254877183549770181269836358732742604905087154537118196933579742249494562611733487750449241765991088186363265450223647106012053374121273867339111198139373125598767690091902245245323403501

view raw ycombinator5.scm hosted with ❤ by GitHub

すげー。これカッチョイイな！！memoized-Y 。

こちらを参考にしました。こんな使い方があったとは・・・。

• さあ、Yコンビネータ(不動点演算子)を使おう！ - よくわかりません

私も以前 JS で Y してるコードがありましたので、うｐ。

	(function (g){
	return g(g);
	})(function (f){
	return function (n){
	return n == 0
	? 1
	: n * f(f)(n - 1);
	};
	})(5);
	(function (g){
	return g(g);
	})(function (f){
	return function (n){
	return n == 0
	? 1
	: n * (function (x)
	{
	return f(f)(x);
	})(n - 1);
	};
	})(5);
	(function (g){
	return g(g);
	})(function (f){
	return (function (h){
	return function (n){
	return n == 0
	? 1
	: n * h(n - 1);
	};
	})(function (x){
	return f(f)(x);
	});
	})(5);
	(function (c){
	return (function (g){
	return g(g);
	})(function (f){
	return c(function (x){
	return f(f)(x);
	});
	});
	})(function (h){
	return function (n){
	return n == 0
	? 1
	: n * h(n - 1);
	};
	})(5);

view raw Y.js hosted with ❤ by GitHub

ほんと、「マクロのない Sceme」といったノリだなーなどと。

• おとうさんにもわかるYコンビネータ！(絵解き解説編) - よくわかりません
• メモ化 - Wikipedia

追記

少し修正したので。

	(define memoized-Y
	(let ((cache (make-hash-table 'equal?)))
	(lambda (c)
	((lambda (f)
	(f f))
	(lambda (g)
	(c (lambda x
	(let ((val (hash-table-get cache x #f)))
	(if val val
	((lambda (ret)
	(hash-table-put! cache x ret)
	ret)
	(apply (g g) x)))))))))))
	(time ((memoized-Y fib) 2000))
	;(time ((memoized-Y fib) 2000))
	; real 0.141
	; user 0.125
	; sys 0.000
	6835702259575806647045396549170580107055408029365524565407553367798082454408054014954534318953113802726603726769523447478238192192714526677939943338306101405105414819705664090901813637296453767095528104868264704914433529355579148731044685634135487735897954629842516947101494253575869699893400976539545740214819819151952085089538422954565146720383752121972115725761141759114990448978941370030912401573418221496592822626

view raw memoized-Y.scm hosted with ❤ by GitHub