[Small-cl-src] Transforming recursion into dynamic programming
Darius Bacon
darius_bacon at yahoo.com
Tue May 18 23:26:07 UTC 2004
;;; Everyone's seen Lisp code to automatically memoize a function.
;;; This is a bit different: it changes the evaluation order from
;;; top-down to bottom-up. A recursive call turns into a direct
;;; reference into the memo table, with no check for whether that
;;; part of the table has been computed yet. See the discussion at
;;; http://lambda.weblogs.com/discuss/msgReader$6437
defmacro defun-recurrence (name params inits &body body)
"Define a recursive function that's evaluated by dynamic programming,
bottom-up from the INITS values to the PARAMS values."
(let ((tabulate-name (concat-symbol "TABULATE-" name))
(table `(make-array (list ,@(mapcar (lambda (p) `(+ ,p 1))
params))))
(ranges (mapcar (lambda (p init) `(for ,p from ,init to ,p))
params
inits)))
`(progn
(defun ,tabulate-name ,params
(tabulate ,name ,table ,ranges , at body))
(defun ,name ,params
(aref (,tabulate-name , at params) , at params)))))
(defmacro tabulate (name table-exp ranges &body body)
"Evaluate a recursive function by dynamic programming, returning
the memo-table."
(let ((table (gensym))
(vars (mapcar #'second ranges)))
`(let ((,table ,table-exp))
,(nest-loops ranges
`(setf (aref ,table , at vars)
(flet ((,name ,vars (aref ,table , at vars)))
, at body)))
,table)))
(defun nest-loops (ranges body-exp)
"Build a nested LOOP form."
(if (null ranges)
body-exp
`(loop ,@(car ranges)
do ,(nest-loops (cdr ranges) body-exp))))
(defun concat-symbol (&rest parts)
"Concatenate symbols or strings to form an interned symbol."
(intern (format nil "~{~a~}" parts)))
More information about the Small-cl-src
mailing list