Search code examples
schemememoizationsicpr5rs

General memoization procedure in Scheme


I am trying to create a general memoization procedure in Scheme. This is what I have so far (it's almost completely the same as excercise 3.27 in the SICP book):

(define (memo proc)
  (let ((table (make-table)))
    (lambda (args)
      (let ((prev (lookup args table)))
        (or prev
            (let ((result (proc args)))
              (insert! args result table)
              result))))))

(The 'make-table', 'insert!' and 'lookup' procedures are defined in the SICP book)

If i call this method with a procedure that only takes one argument, it works just fine. What I can't figure out how to do is get it to work with a procedure that takes 0 or several arguments.

I found this link: http://community.schemewiki.org/?memoization , but I still can't get it to work. The procedure in the link uses apply values and call-with-values, and even though I got a rough idea on how they work, I can't seem to integrate it with my procedure.

 (define (mem2 proc)
   (let ((table (make-table)))
        (lambda args
          (let ((prev (lookup args table)))
            (or prev
                (call-with-values
                 (lambda () (apply proc args))
                 (lambda (result)
                   (insert! args result table)
                   result)))))))

This is my try on the procedure from the link, using a list. It's almost working, but if I have a procedure that takes several arguments, it will compute it several times. Let's say I pass a random procedure the arguments 1 2 3 4. It will save 1 2 3 4 in the table, but not the given results for 1, 2, 3 and 4 seperately. I guess my error is where I do the lookup, since I pass the whole list at once.

EDIT: added testprocedure that mem2 does not work correctly with.

(define (add . args)
  (display "computing add of ")
  (display args) (newline)
  (if (null? args)
      0
      (+ (car args) (apply add (cdr args)))))

It will save in the lookup table the whole 'args'. So if I have:

(define add (mem2 add))

(add 2 3 4)

computing add of (2 3 4)

computing add of (3 4)

computing add of (4)

9

(add 3)

computing add of (3)


Solution

  • (define (make-table)
      (vector '()))
    
    (define (insert! key val t)
      (vector-set! t 0 (cons (cons key val) (vector-ref t 0))))
    
    (define (lookup key t)
      (let ([result (assoc key (vector-ref t 0))])
        (and result (cdr result))))
    
    (define (mem2 proc)
      (let ((table (make-table)))
        (lambda args
          (let ((prev (lookup args table)))
            (or prev
                (let ([result (apply proc args)])
                  (insert! args result table)
                  result))))))
    
    (define (plus x y)
      (display (list "Computing sum of: " x y))
      (newline)
      (+ 1 2))
    
    (define memo-plus (mem2 plus))
    
    (memo-plus 1 2)
    (memo-plus 1 2)
    

    Output:

    (Computing sum of:  1 2)
    3
    3
    

    Adding:

    (define (add . args)
      (display "computing add of ")
      (display args) (newline)
      (if (null? args)
          0
          (+ (car args) (apply add (cdr args)))))
    
    (define memo-add (mem2 add))
    
    (memo-add 1 2 3 4)
    (memo-add 1 2 3 4)
    

    Gives the output:

    computing add of (1 2 3 4)
    computing add of (2 3 4)
    computing add of (3 4)
    computing add of (4)
    computing add of ()
    10
    10
    

    Since nothing was printed before the last 10, the example show that the result was memoized.