在任意维度的 table 中的现有路径中插入密钥

Insert key in existing path in table of arbitrary dimensions

SICP question 3.25 状态:

[S]how how to implement a table in which values are stored under an arbitrary number of keys and different values may be stored under different numbers of keys. The lookup and insert! procedures should take as input a list of keys used to access the table.

这里的 table 是一种数据结构,其中可以使用任意数量的键来检索值。例如,在

(define t (make-table))
(define get (t 'lookup-proc))
(define put (t 'insert-proc!))

以下代码应在键 'a 'b 'c 之后放置符号 'hello:

(put (list 'a 'b 'c) 'hello)
(get (list 'a 'b 'c))
; => 'hello

受到 solution 的启发,我正在使用以下 insert-proc 程序:

(define (insert! keys value)
 (define (foldl op acc lst)
   (if (null? lst)
       acc
       (foldl op (op acc (car lst)) (cdr lst))))
 (define (descend table key)
   (let ((record (assoc key (cdr table))))
     (if record
         record
         (let ((new (cons (list key) (cdr table))))
           (set-cdr! table new)
           (car new)))))
 (set-cdr! (foldl descend local-table keys) value))

(我正在使用的完整代码可以在 this gist 中找到。)

代码如上例所示。但是当我在现有路径上插入一个新值时,我会得到以下行为:

(put (list 'a 'b 'c) 'hello)
(put (list 'a 'b) 'hi) ; Or (put (list 'a 'b 'c 'd) 'hi)
; =>  mcar: contract violation
;     expected: mpair?
;     given: 'hello

有谁知道为什么不能在 table 中的现有路径中插入密钥,以及如何才能做到这一点?

谢谢。

我相信实现比这更棘手......在为已经存在的密钥重建 table 时你必须更加小心。试试这个:

(require scheme/mpair)

(define (make-table)

  (let ((table (mlist '*table*)))

    (define (lookup keys)
      (let loop ((table table)
                 (keys  keys))
        (let ((rest     (cdr keys))
              (subtable (massoc (car keys) (mcdr table))))
          (if subtable
              (if (null? rest)
                  (mcdr subtable)
                  (loop subtable rest))
              #f))))

    (define (insert! keys value)
      (let loop ((table table)
                 (keys  keys))
        (let* ((key  (car keys))
               (rest (cdr keys))
               (subtable (if (mlist? table)
                             (massoc key (mcdr table))
                             #f)))
          (if subtable
              (if (null? rest)
                  (set-mcdr! subtable value)
                  (loop subtable rest))
              (cond ((and (null? rest) table)
                     (set-mcdr! table (mlist (mcons key value))))
                    ((null? rest)
                     (mcons key value))
                    (table
                     (set-mcdr! table
                                (mcons (mlist key (loop subtable rest))
                                       (mcdr table))))
                    (else
                     (mcons key (mlist (loop subtable rest)))))))))

    (lambda (msg)
      (case msg
        ('lookup-proc  lookup)
        ('insert-proc! insert!)
        (else (error "MAKE-TABLE -- undefined operation" msg))))))

它按预期工作:

(define t (make-table))
(define get (t 'lookup-proc))
(define put (t 'insert-proc!))

(put '(a b c) 'hello)
(get '(a b c))
=> 'hello

(put '(a b) 'hi)
(get '(a b))
=> 'hi