>假设我有一个表示布尔表达式的任意列表:
'(a and (b or c))
和另一个表示文本值的对列表
'((a . #t) (b . #f) (c . #t)))
我想做的是使用第二个列表中的值替换第一个列表中的值,并返回一个新列表:
'(#t and (#f or #t))
因此,例如,此代码采用列表和关联列表,并成功替换其中的值,尽管我正在尝试在给定缺点列表而不是关联列表的情况下做同样的事情。它适用于'(a b) '((a 1) (b 2)) -> '(1 2)
,但我想改用'((a . 1) (b . 2))
。这是该代码:
(define replace
(lambda (ls a-list)
(map (lambda (x)
(let ((lookup (assq x a-list)))
(if lookup
(cadr lookup)
x)))
ls)))
有人知道怎么做吗?非常感谢!
像这样:
(define bool '(a and (b or c)))
(define pairs '((a . #t) (b . #f) (c . #t)))
(define (value-for-key lst key)
(cond ((empty? lst) 'none)
((eq? key (caar lst))
(cdar lst))
(#t (value-for-key (cdr lst) key))))
(define (replace-bool lst vals)
(cond ((empty? lst) lst)
((pair? (car lst)) (cons (replace-bool (car lst) vals)
(replace-bool (cdr lst) vals)))
(#t (let ((val-for-key (value-for-key vals (car lst))))
(if (not (eq? val-for-key 'none))
(cons val-for-key (replace-bool (cdr lst) vals))
(cons (car lst) (replace-bool (cdr lst) vals)))))))
(replace-bool bool pairs)
->(#t 和(#f 或 #t))
第一个函数用于搜索对键值列表,并返回给定键的值或"无",如果该键不在该列表中。
第二个函数通过布尔表达式列表。在键值列表中搜索每个原子元素,如果找到,则替换。如果布尔表达式包含嵌套表达式,则以递归方式遍历这些表达式。
这里真正的问题似乎是需要一个适用于嵌套输入列表的解决方案。为此,可以编写一个map-nested
程序。这是一个过程,类似于通常map
过程的简化版本,但它适用于嵌套列表:
(define (map-nested proc xss)
(if (null? xss)
'()
(let ((xs (car xss)))
(if (pair? xs)
(cons (map-nested proc xs)
(map-nested proc (cdr xss)))
(cons (proc xs)
(map-nested proc (cdr xss)))))))
这与通常map
不同的一种方式是map-nested
只接受一个列表作为输入;典型的map
过程采用任意数量的可以映射的列表。
上述map-nested
实现不是尾递归的,这对于大型深度嵌套列表来说可能是一个问题。重写它并不麻烦,使其成为一个迭代(尾递归)过程:
(define (map-nested proc xss)
(let iter ((xss xss)
(result '()))
(if (null? xss)
(reverse result)
(let ((xs (car xss)))
(if (pair? xs)
(iter (cdr xss)
(cons (map-nested proc xs) result))
(iter (cdr xss)
(cons (proc xs) result)))))))
这里result
是一个累加器,它跟踪要返回的结果,使递归调用无需保留堆栈帧。请注意,result
在返回之前必须反转,因为输入中的元素从输入列表的前面开始,被安排在result
的前面。此处使用命名的 let 表单;这是一种在另一个函数中设置本地程序的便捷方法,该函数在 Scheme 和 Racket 中都有效。
要完成解决OP的问题,我们只需要使用map-nested
;上述任何一个版本都可以工作:
;;; `substs` is an a-list of the form `((a . x) (b . y) ...)`
(define (replace-elts xss substs)
(map-nested (lambda (x)
(let ((subst-pair (assoc x substs)))
(if subst-pair ; subst-pair is #f if x is not found
(cdr subst-pair) ; otherwise, subst-pair is a dotted pair
x)))
xss))
在这里,map-nested
负责处理输入列表,无论它是否嵌套。给proc
的过程负责在substs
中寻找一个替换,它被假定为一个由虚线对组成的关联列表。如果需要两个元素的正确列表而不是点对,则可以简单地将cdr
更改为cadr
。当subst
没有为输入xss
中的值提供替换时,该值保持不变。
根据实际使用条件,可以通过多种方式更改replace-elts
以或多或少方便。
示例交互:
nested-map.rkt> (replace-elts '(a (b (c d) e))
'((a . 1) (b . 2) (c . 3) (d . 4) (e . 5)))
'(1 (2 (3 4) 5))
nested-map.rkt> (replace-elts '(a (b (c d) e))
'((a . 1) (b . 2) (c . 3) (d . 4)))
'(1 (2 (3 4) e))
nested-map.rkt> (replace-elts '(a and (b or c))
'((a . #t) (b . #f) (c . #t)))
'(#t and (#f or #t))
有一个Common Lisp 函数sublis
正是这样做的,但它和其他处理 cons 单元格树结构而不是直线列表的 CL 函数一样,从未进入 Scheme 世界:
* (sublis '((a . t) (b . nil) (c . t)) '(a and (b or c)))
(T AND (NIL OR T))
不久前,我编写了许多Common Lisp函数的Racket实现,包括这个。
(define (sublis alist tree #:test [test eqv?] #:key [key identity])
(cond
((assoc (key tree) alist test) => cdr)
((pair? tree)
(let ([new-car (sublis alist (car tree) #:test test #:key key)]
[new-cdr (sublis alist (cdr tree) #:test test #:key key)])
(if (and (eqv? (car tree) new-car)
(eqv? (cdr tree) new-cdr))
tree
(cons new-car new-cdr))))
(else tree)))
例:
> (sublis '((a . #t) (b . #f) (c . #t)) '(a and (b or c)))
'(#t and (#f or #t))