scheme - 将代码从 Lisp 转换为 SCHEME

Question

我在 Common Lisp 中有一个工作程序，我正试图让它在 Scheme 中也能工作，但它不工作。该代码是关于名为 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 中没有 remove-if 用于 extiende

的定义

(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))

(一)

(primero-en-profundidad '(a) '(k))

(A C G K)

Answer 1

常见的 Lisp 问题

(setq vecinos '((a . (b c d)) ...)

使用 *earmuffs*，即全局(特殊)变量周围的星号。另外，不要对 undefined variable 使用 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 测试，它测试“相同的非复合值” ”。对于包含相同元素的不同列表，它返回 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 提示

Racket 定义了一个 filter 保持元素满足谓词的函数。您需要使用 complement (not?)你的谓词。