  -*- Mode : LISP ; Syntax : Common - lisp ; Package : Memoization ; Base : 10 -*-

(in-package "MEMOIZATION")

;;;===========================================================================
  ( C ) 1992   . Permission is granted for any use or modification
       of this code provided this notice is retained . Version of 8/93 .
;;;===========================================================================

;;;===========================================================================
  This file is one of four files that define the Memoization facility :
     - Load - Memoization : Defines Memoization package and loads other 3 files
;;;    - Memoization: Defines core memoization routines.
;;;    - Save-Memo-Table: Defines routines to save and load hash tables
;;;                       associated with a memoized function.
;;;    - Memoization-Examples [THIS FILE]: Simplistic version of memoization to
                                         illustrate the principle , and 2
;;;                                        example functions to which 
;;;                                        memoization can be applied.
;;; This file contains the following:
;;;    - Basic-Memo: A simplistic version of "Memo" (which appears in the file
;;;      ==========  Memoization.lisp). It takes a function object and returns
;;;                  an "equivalent" one that remembers previous args. It is
                   restricted to functions that take exactly one parameter ,
;;;                  where that parameter is testable by "eq".
     - Basic - Memoize : A simplistic version of " Memoize " ( also appears in the
;;;      =============  file Memoization.lisp). Takes a function NAME as
;;;                     argument, looks up the associated function object, 
;;;                     makes a new one via Basic-Memo, and then associates 
;;;                     that new one with the the function name it was given.
;;;    - Fib: A deliberately inefficient recursive implementation of a routine
       = = =   to calculate the  fibonacci number . Although it is easy to
            fix the inefficiency without resorting to memoization , 
;;;           it is illustrative of how memoization performs.
;;;    - Divided-Difference: Slightly more complex example in the vein of Fib
;;;      ==================
;;;
   
  The Johns Hopkins University Applied Physics Lab
;;; Room 7-38
  Johns Hopkins Rd .
    
  
  ( 410 ) 792 - 6000 x3440
;;;
;;;===========================================================================


;;;===========================================================================
;;; Simplest version to give the idea. Takes a function object as an argument
;;; and returns another one that does lookup from a hash table. The idea is
;;; that this new function, if called with an argument it has seen before,
;;; simply returns the corresponding value in the hash table. For a new
;;; argument, this new function will call the original function, stick the
;;; resultant value in the hash table, then return that value. For this simple
;;; case, function can only have a single argument that can be compared via
;;; eql. Normally used via "Basic-Memoize", but could be invoked
  directly by   ( setq Bar ( Basic - Memo # ' Foo ) ) , then ( funcall Bar < Arg > ) .
;;;
  Derived from code in    _ Paradigms of AI Programming : Case
  Studies in Common LISP _ ,   , 1992 .

(defun Basic-Memo (Function)
  "Takes a normal function object and returns an `equivalent' memoized one"
  (let ((Hash-Table (make-hash-table)))
    #'(lambda (Arg)
	(multiple-value-bind (Value Foundp)
	    (gethash Arg Hash-Table)
	  (if
	    Foundp
	    Value
	    (setf (gethash Arg Hash-Table) (funcall Function Arg))))) ))

;;;===========================================================================
;;; Changes the symbol function, so that you can memoize recursive functions,
;;; and so that you can avoid changing any of the other code that already
;;; calls the existing function.
;;;
  Derived from code in    _ Paradigms of AI Programming : Case
  Studies in Common LISP _ ,   , 1992 .

(defun Basic-Memoize (Function-Name)
  "Memoize function associated with Function-Name. Simplified version"
  (setf (symbol-function Function-Name)
	(Basic-Memo (symbol-function Function-Name))))

;;;===========================================================================
  As described in section 2 of the main memoization file , there are four
  basic applications of memoization . The first , which is illustrated below ,
;;; is when a single routine calls some subroutine (or itself recursively)
  more than is needed , resulting in extra calculations . By  , these
;;; results are returned immediately for subsequent calls, with the effect of
  dynamic programming . In fact , this first case can be thought of as a tool
;;; for automatic dynamic programming, but without the need to build the
;;; subpieces in the correct order. This can frequently reduce the time of
;;; exponential algorithms to polynomial or even linear time.
;;;===========================================================================
 
;;;===========================================================================
;;; Simple example for testing. A silly recursive algorithm for finding the
  Nth Fibonacci number , assuming the 0th is 0 , the 1st is 1 , and all the
  rest are the sum of the previous two . Doing ( Memoize '  ) or changing the
  " defun " to " Define - Memo - Function " results in a reduction from exponential
  complexity ( Golden - Ratio to the N ) to linear on the first run , plus it
;;; gives constant time results on anything previously calculated. Of course,
;;; this is a deliberately poor way to write a recursive definition, but
;;; illustrates the point well (try timing it both ways for moderate sized
  N 's ) . Besides , even the obvious iterative or tail - recursive algorithms get
;;; no better than linear complexity. Since this function only takes a single
  argument that is testable by eq , ( Basic - Memoize '  ) is sufficient . Try
;;; timing a case before and after this.
;;;
;;; On most machines, the unmemoized version should start slowing down around
  N = 28 or so .
;;;
  WARNING ! On Lucid , if you compile with speed 3 , you get " optimization of
;;; tail calls", which is actually removal of all directly recursive calls.
  This can be changed back by either a SPEED optimization of 2 , or an
  explicity setting of ( common - lisp - user::compiler - options : tail - merge NIL ) . Giving a
  NOTINLINE proclamation is not sufficient . This same problem may occur on
;;; other systems as well, so be on the lookout.

(defun Fib (N)
  "Returns Nth Fibonacci number, where 0th is 0, 1st is 1,
   and the rest are the sum of the previous two."
  (if
    (<= N 1)
    N
    (+ (Fib (- N 1)) (Fib (- N 2)))))

;;;===========================================================================
;;; An example for testing. This computes the divided differences used in
;;; determining coefficients when interpolating polynomials. Algorithm is
  taken from  and  , _ Numerical Mathematics and Computing _ ,
  Brooks / Cole , 1980 . The point is that the algorithm , as written , performs
;;; wasted calculations, resulting in O(2^N) complexity. The memoized version
  has O(N^2 ) complexity in the first invocation , since it calculates only
  once for each of the subsequences of Points , and there are 1 + 2 + 3+ ... +N =
;;; N(N+1)/2 subsequences. Later invocations with the same parameters have
;;; effectively constant-time results. Both this and the following example are
;;; deliberately simple ones to illustrate the idea, and in neither case is it
;;; very difficult to discover a better order to get the same performance as
  the first invocation of the memoized version . But the transparent syntax
;;; and lack of additional debugging required often makes memoization an
;;; attractive alternative. Also, in many cases the alternative algorithm is
  less obvious . For instance ,  the simple , obvious algorithms for
  the matrix chain multiplication problem or the 0/1 knapsack problem give
;;; results with the same efficiency as the best dynamic programming
  algorithms . Similarly ,   showed that  a simple
;;; recursive descent parser can yield the same performance on context free
  grammars as Chart Parsing or Earley 's Algorithm .
;;;
  Unlike  , this problem requires the real memoization routine , not just
;;; Basic-Memoize. Using this as an example for memoization was suggested by
    of Symbolics .
;;;
;;; As a test case, try (Divided-Difference #'Test-Function (First-N <X>))
;;; On most machines, the unmemoized version should start slowing down around
  < X > = 14 or so .

(defun Divided-Difference (Function Points)
  "Determines kth coefficient, where `Points' contains k entries"
  (if
    (null (rest Points))
    (apply Function Points)
    (/ (- (Divided-Difference Function (rest Points))
	  (Divided-Difference Function (butlast Points)))
       (- (first (last Points)) (first Points)))) )

;;;-----------------------------------------------------------
;;; Relatively arbitrary test function.

(defun Test-Function (N)
  (* N (cos N)))

;;;-----------------------------------------------------------
  This is just ( loop for I from 1 to N collecting I ) , but CLtL/1
;;; compatibility was desired.
 
(defun First-N (N)
  (let ((List '()))
    (dotimes (I N (reverse List))
      (push (1+ I) List))) )

;;;===========================================================================

 Syntax : Common - lisp ; Package : Memoization ; Base : 10 -*-
===========================================================================
===========================================================================
===========================================================================
    - Memoization: Defines core memoization routines.
    - Save-Memo-Table: Defines routines to save and load hash tables
                       associated with a memoized function.
    - Memoization-Examples [THIS FILE]: Simplistic version of memoization to
                                        example functions to which 
                                        memoization can be applied.
 This file contains the following:
    - Basic-Memo: A simplistic version of "Memo" (which appears in the file
      ==========  Memoization.lisp). It takes a function object and returns
                  an "equivalent" one that remembers previous args. It is
                  where that parameter is testable by "eq".
      =============  file Memoization.lisp). Takes a function NAME as
                     argument, looks up the associated function object, 
                     makes a new one via Basic-Memo, and then associates 
                     that new one with the the function name it was given.
    - Fib: A deliberately inefficient recursive implementation of a routine
           it is illustrative of how memoization performs.
    - Divided-Difference: Slightly more complex example in the vein of Fib
      ==================

 Room 7-38

===========================================================================
===========================================================================
 Simplest version to give the idea. Takes a function object as an argument
 and returns another one that does lookup from a hash table. The idea is
 that this new function, if called with an argument it has seen before,
 simply returns the corresponding value in the hash table. For a new
 argument, this new function will call the original function, stick the
 resultant value in the hash table, then return that value. For this simple
 case, function can only have a single argument that can be compared via
 eql. Normally used via "Basic-Memoize", but could be invoked

===========================================================================
 Changes the symbol function, so that you can memoize recursive functions,
 and so that you can avoid changing any of the other code that already
 calls the existing function.

===========================================================================
 is when a single routine calls some subroutine (or itself recursively)
 results are returned immediately for subsequent calls, with the effect of
 for automatic dynamic programming, but without the need to build the
 subpieces in the correct order. This can frequently reduce the time of
 exponential algorithms to polynomial or even linear time.
===========================================================================
===========================================================================
 Simple example for testing. A silly recursive algorithm for finding the
 gives constant time results on anything previously calculated. Of course,
 this is a deliberately poor way to write a recursive definition, but
 illustrates the point well (try timing it both ways for moderate sized
 no better than linear complexity. Since this function only takes a single
 timing a case before and after this.

 On most machines, the unmemoized version should start slowing down around

 tail calls", which is actually removal of all directly recursive calls.
 other systems as well, so be on the lookout.
===========================================================================
 An example for testing. This computes the divided differences used in
 determining coefficients when interpolating polynomials. Algorithm is
 wasted calculations, resulting in O(2^N) complexity. The memoized version
 N(N+1)/2 subsequences. Later invocations with the same parameters have
 effectively constant-time results. Both this and the following example are
 deliberately simple ones to illustrate the idea, and in neither case is it
 very difficult to discover a better order to get the same performance as
 and lack of additional debugging required often makes memoization an
 attractive alternative. Also, in many cases the alternative algorithm is
 results with the same efficiency as the best dynamic programming
 recursive descent parser can yield the same performance on context free

 Basic-Memoize. Using this as an example for memoization was suggested by

 As a test case, try (Divided-Difference #'Test-Function (First-N <X>))
 On most machines, the unmemoized version should start slowing down around
-----------------------------------------------------------
 Relatively arbitrary test function.
-----------------------------------------------------------
 compatibility was desired.
===========================================================================

(in-package "MEMOIZATION")

  ( C ) 1992   . Permission is granted for any use or modification
       of this code provided this notice is retained . Version of 8/93 .

  This file is one of four files that define the Memoization facility :
     - Load - Memoization : Defines Memoization package and loads other 3 files
                                         illustrate the principle , and 2
                   restricted to functions that take exactly one parameter ,
     - Basic - Memoize : A simplistic version of " Memoize " ( also appears in the
       = = =   to calculate the  fibonacci number . Although it is easy to
            fix the inefficiency without resorting to memoization , 
   
  The Johns Hopkins University Applied Physics Lab
  Johns Hopkins Rd .
    
  
  ( 410 ) 792 - 6000 x3440


  directly by   ( setq Bar ( Basic - Memo # ' Foo ) ) , then ( funcall Bar < Arg > ) .
  Derived from code in    _ Paradigms of AI Programming : Case
  Studies in Common LISP _ ,   , 1992 .

(defun Basic-Memo (Function)
  "Takes a normal function object and returns an `equivalent' memoized one"
  (let ((Hash-Table (make-hash-table)))
    #'(lambda (Arg)
	(multiple-value-bind (Value Foundp)
	    (gethash Arg Hash-Table)
	  (if
	    Foundp
	    Value
	    (setf (gethash Arg Hash-Table) (funcall Function Arg))))) ))

  Derived from code in    _ Paradigms of AI Programming : Case
  Studies in Common LISP _ ,   , 1992 .

(defun Basic-Memoize (Function-Name)
  "Memoize function associated with Function-Name. Simplified version"
  (setf (symbol-function Function-Name)
	(Basic-Memo (symbol-function Function-Name))))

  As described in section 2 of the main memoization file , there are four
  basic applications of memoization . The first , which is illustrated below ,
  more than is needed , resulting in extra calculations . By  , these
  dynamic programming . In fact , this first case can be thought of as a tool
 
  Nth Fibonacci number , assuming the 0th is 0 , the 1st is 1 , and all the
  rest are the sum of the previous two . Doing ( Memoize '  ) or changing the
  " defun " to " Define - Memo - Function " results in a reduction from exponential
  complexity ( Golden - Ratio to the N ) to linear on the first run , plus it
  N 's ) . Besides , even the obvious iterative or tail - recursive algorithms get
  argument that is testable by eq , ( Basic - Memoize '  ) is sufficient . Try
  N = 28 or so .
  WARNING ! On Lucid , if you compile with speed 3 , you get " optimization of
  This can be changed back by either a SPEED optimization of 2 , or an
  explicity setting of ( common - lisp - user::compiler - options : tail - merge NIL ) . Giving a
  NOTINLINE proclamation is not sufficient . This same problem may occur on

(defun Fib (N)
  "Returns Nth Fibonacci number, where 0th is 0, 1st is 1,
   and the rest are the sum of the previous two."
  (if
    (<= N 1)
    N
    (+ (Fib (- N 1)) (Fib (- N 2)))))

  taken from  and  , _ Numerical Mathematics and Computing _ ,
  Brooks / Cole , 1980 . The point is that the algorithm , as written , performs
  has O(N^2 ) complexity in the first invocation , since it calculates only
  once for each of the subsequences of Points , and there are 1 + 2 + 3+ ... +N =
  the first invocation of the memoized version . But the transparent syntax
  less obvious . For instance ,  the simple , obvious algorithms for
  the matrix chain multiplication problem or the 0/1 knapsack problem give
  algorithms . Similarly ,   showed that  a simple
  grammars as Chart Parsing or Earley 's Algorithm .
  Unlike  , this problem requires the real memoization routine , not just
    of Symbolics .
  < X > = 14 or so .

(defun Divided-Difference (Function Points)
  "Determines kth coefficient, where `Points' contains k entries"
  (if
    (null (rest Points))
    (apply Function Points)
    (/ (- (Divided-Difference Function (rest Points))
	  (Divided-Difference Function (butlast Points)))
       (- (first (last Points)) (first Points)))) )


(defun Test-Function (N)
  (* N (cos N)))

  This is just ( loop for I from 1 to N collecting I ) , but CLtL/1
 
(defun First-N (N)
  (let ((List '()))
    (dotimes (I N (reverse List))
      (push (1+ I) List))) )

