我在Common Lisp中有一个工作程序，我也试图让它在Scheme中工作，但是它没有用。代码是关于estructure中名为 vecinos 的深度优先搜索 Lisp代码：
(setq vecinos '((a . (b c d))
(b . (a h))
(c . (a g))
(d . (g))
(g . (c d k))
(h . (b))
(g . (k)) ) )
( cdr (assoc 'a vecinos))
( cdr (assoc 'b vecinos))
(defmacro get.value (X vecinos) `(cdr (assoc, X, vecinos)))
(defun extiende (trayectoria)
(mapcar #'(lambda (nuevo-nodo) (append trayectoria (list nuevo-nodo)))
(remove-if #'(lambda (vecino) (member vecino trayectoria))
(get.value (car (last trayectoria)) vecinos))))
(defun primero-en-profundidad (inicial final)
(primero-en-profundidad-aux inicial final (list (list inicial))))
(defun primero-en-profundidad-aux (inicial final abierta)
(cond ((eq inicial final)
(print (list inicial)))
((member (list inicial final) (extiende (list inicial)))
(print (list inicial final)))
((member final (first abierta))
(print (first abierta)))
(t (primero-en-profundidad-aux inicial final (append (extiende (first abierta)) (rest abierta))))
))
(primero-en-profundidad 'a 'a)
(primero-en-profundidad 'a 'k)
计划代码：
#lang scheme
(define vecinos '((a . (b c d))
(b . (a h))
(c . (a g))
(d . (g))
(g . (c d k))
(h . (b))
(g . (k)) ) )
(define (get-value X vecinos)
(cond ((eq? (assoc X vecinos) #f) null)
(#t (cdr (assq X vecinos)) ) ))
我认为这是错误的，因为在Scheme中 extiende
的定义中没有 remove-if(define (extiende trayectoria)
(map car (lambda (nuevo-nodo) (append trayectoria (list nuevo-nodo)))
(remove-if (lambda (vecino) (member vecino trayectoria))
(get-value (car (last trayectoria)) vecinos))))
(define (primero-en-profundidad inicial final)
(primero-en-profundidad-aux inicial final (list (list inicial))))
(define (primero-en-profundidad-aux inicial final abierta)
(cond ((eqv? inicial final)
(print (list inicial)))
((member (list inicial final) (extiende (list inicial)))
(print (list inicial final)))
((member final (first abierta))
(print (first abierta)))
(#t (primero-en-profundidad-aux inicial final (append (extiende (first abierta)) (rest abierta))))
))
结果应为
(primero-en-profundidad '(a) '(a))
（A）
(primero-en-profundidad '(a) '(k))
（A C G K）
答案 0 :(得分：4)
(setq vecinos '((a . (b c d)) ...)
使用*earmuffs*，即围绕全局（特殊）变量的星号。另外，不要将setq与未定义的变量一起使用。请参阅Difference between `set`, `setq`, and `setf` in Common Lisp?。
(defun primero-en-profundidad-aux (inicial final abierta)
(cond ((eq inicial final)
(print (list inicial)))
;; dead code
;; ((member (list inicial final) (extiende (list inicial)))
;; (print (list inicial final)))
((member final (first abierta))
(print (first abierta)))
(t (primero-en-profundidad-aux inicial final (append (extiende (first abierta)) (rest abierta))))))
标记为死代码的部分已失效，因为member默认情况下使用eql进行测试，这会测试＆＃34;相同的非复合值＆＃34; 。如果不同的列表包含相同的元素，则返回nil。此外，代码并不是必需的，因为据我所知，它包含在最后一个测试中。
作为参考，这是一个重写的CL实现。主要区别在于每个路径都用作堆栈：原始实现保持附加在列表的末尾，这需要大量遍历并产生大量分配（当前实现在资源方面仍远未达到最优化用法，但它接近原始）。只有在必要时，路径才会反转。
(defpackage :vecinos (:use :cl))
(in-package :vecinos)
(defparameter *graph*
'((a . (b c d))
(b . (a h))
(c . (a g))
(d . (g))
(g . (c d k))
(h . (b))
(g . (k))))
;; might as well be a function
(defmacro adjacent-nodes (node graph)
`(cdr (assoc ,node ,graph)))
(defun unvisited-neighbours (node path graph)
(remove-if (lambda (neighbour)
(member neighbour path))
(adjacent-nodes node graph)))
(defun extend-path (path graph)
(mapcar (lambda (new-node)
(cons new-node path))
(unvisited-neighbours (first path) path graph)))
;; use a local auxiliary function (with labels)
(defun depth-first-search (initial final graph)
(labels ((dfs (paths)
(cond
((not paths) nil)
((eq initial final) (list initial))
((member final (first paths))
(reverse (first paths)))
(t (dfs (append (extend-path (first paths) graph)
(rest paths)))))))
(dfs (list (list initial)))))
(depth-first-search 'a 'k *graph*)
Racket定义了一个filter函数，保持元素满足谓词。您需要使用谓词的complement (not?)。
答案 1 :(得分：2)
首先，非常感谢@coredump大力改进CL中的代码！
我将它转移到了Racket。
#lang racket
(define *graph*
'((a . (b c d))
(b . (a h))
(c . (a g))
(d . (g))
(g . (c d k))
(h . (b))
(g . (k))))
(define (adjacent-nodes node graph)
(cdr (assoc node graph)))
(define (unvisited-neighbours node path graph)
(filter-not (lambda (neighbour)
(member neighbour path))
(adjacent-nodes node graph)))
(define (extend-path path graph)
(map (lambda (new-node)
(cons new-node path))
(unvisited-neighbours (first path) path graph)))
;; use a local auxiliary function with CL labels => Racket letrec
(define (depth-first-search initial final graph)
(letrec ((dfs (lambda (paths)
(cond ((not paths) '())
((eq? initial final) (list initial))
((member final (first paths))
(reverse (first paths)))
(else (dfs (append (extend-path (first paths) graph)
(rest paths))))))))
(dfs (list (list initial)))))
小测试：
(depth-first-search 'a 'a *graph*)
;; '(a)
(depth-first-search 'a 'k *graph*)
;; '(a c g k)
从CL转移到Racket的一些规则（只是规则的一小部分，但对于这个例子来说已足够）：
;; CL function definitions (defun fn-name (args*) <body>)
;; Racket function definitions (define (fn-name args*) <body>)
;; ;; expands to the old notation:
;; (define fn-name (lambda (args*) <body>)
;; which shows that fn-name is just
;; a variable name which bears in
;; itself a lambda-expression
;; a named lambda so to say
;; this shows the nature of functions
;; in racket/scheme:
;; just another variable (remember:
;; racket/scheme is a Lisp1,
;; so variables and functions share
;; the same namespace!)
;; while in CL, which is a Lisp2,
;; variables have a different namespace
;; than functions.
;; that is why in CL you need `#'`
;; attached in front of function names
;; when passed to higher order functions
;; as arguments telling:
;; lookup in function namespace!
;; consequently, there is no
;; `#'` notation in racket/scheme.
;; CL (cond ((cond*) <body>)
;; (t <body>))
;; Racket (cond ((cond*) <body>)
;; (else <body>))
;; truth t nil
;; #t #f in Racket, '() is NOT false!
;; CL '() = () = 'nil = nil
;; Racket '() [ () is illegal empty expression ]
;; != '#t = #t
;; CL mapcar
;; Racket map
;; CL remove-if-not remove-if
;; Racket filter filter-not
;; CL labels
;; Racket letrec ((fn-name (lambda (args*)
;; <body>))
;; CL predicates - some have `p` at end (for `predicate`), some not
;; and historically old predicates have no `p` at end.
;; eq equal atom null
;; = > < etc.
;; string= etc char=
;; evenp oddp
;; Racket predicates much more regularly end with `?`
;; eq? equal? atom? null?
;; = > < etc. ;; well, but for numerical ones no `?` at end
;; string=? etc. char=?
;; even? odd?