メモ化マクロを作ってみた(tarai)

scheme

e.g.

;;メモ化マクロ(define-memoize)を利用
(define-memoize (tarai (x 'eqv?) (y 'eqv?) (z 'eqv?))
  (if (<= x y)
      y
      (tarai (tarai (1- x) y z) (tarai (1- y) z x) (tarai (1- z) x y))))

;;普通の定義
(define (tarai2 x y z)
  (if (<= x y)
      y
    (tarai2 (tarai2 (1- x) y z) (tarai2 (1- y) z x) (tarai2 (1- z) x y))))

(define (1- x) (- x 1))


(let ((*x* #f) (*y* #f))
  (time (set! *x* (tarai 12 7 0)))
  (time (set! *y* (tarai2 12 7 0)))
  (print (equal? *x* *y*)))

;; ;(time (set! *x* (tarai 12 7 0)))
;; ; real   0.001
;; ; user   0.000
;; ; sys    0.000
;; ;(time (set! *y* (tarai2 12 7 0)))
;; ; real   1.810
;; ; user   1.720
;; ; sys    0.000
;; #t

code

(use util.match)

(define-macro (define-memoize . args)
  ;;(define-memoize (name ((arg cmpf) ...)
  ;;                       body ...)
  (define (memo-get-recursive ht calc keys eqs)
    (let loop ((ht ht) (args (map list keys eqs)))
      (match args
	[((key #f))
	 `(or (hash-table-get ,ht ,key #f)
	      (rlet1 ans (,calc ,@keys)
		(hash-table-put! ,ht ,key ans)))]
	[((key eq) . rest)
	 (let1 next-table (gensym)
	   `(let1 ,next-table (or (hash-table-get ,ht ,key #f)
				  (make-hash-table ,eq))
	      (rlet1 ans ,(loop next-table rest)
		(hash-table-put! ,ht ,key ,next-table))))])))
  (match args
    [((name . head) . body)
     (let ((keys (map car head))
	   (cmpfs (map cadr head))
	   (ht (gensym)) (calc (gensym)))
       `(define ,name
	  (let1 ,ht (make-hash-table ,(car cmpfs))
	    (define (,calc ,@keys)
	      ,@body)
	    (lambda ,keys
	      ,(memo-get-recursive ht calc keys `(,@(cdr cmpfs) #f))))))]))

n引数の手続きの場合、どちらの方がいいんだろう？

  • 1つのhash-tableに対してkeyをリストにしてequal?で比較してメモ化
  • hash-tableをネストさせていく
    • (get (get (get ht k0) k1) k2)というような。
;;keyをlistにしてequal?で比較
(define tarai3
  (let1 ht (make-hash-table 'equal?)
    (define (calc x y z)
      (if (<= x y)
	  y
	  (tarai3 (tarai3 (1- x) y z) (tarai3 (1- y) z x) (tarai3 (1- z) x y))))
    (lambda (x y z)
      (let1 key (list x y z)
	(or (hash-table-get ht key #f)
	    (rlet1 r (calc x y z)
		(hash-table-put! ht key r)))))))

;; ;(time (set! *x* (tarai 200 150 0)))
;; ; real   0.183
;; ; user   0.160
;; ; sys    0.020
;; ;(time (set! *z* (tarai3 200 150 0)))
;; ; real   0.193
;; ; user   0.180
;; ; sys    0.000

equal?の速度が遅くならないようなものなら、直接listをKeyにして比較しても良さそう。
頑張ったのは徒労だったかもしれない。