将代码从 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 中，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))

（一）

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

(A C G K)

Answer 1

首先，非常感谢@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?

Answer 2

常见的 Lisp 问题

(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 进行测试，它测试“相同的非复合值”。对于包含相同元素的不同列表，它返回 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?)。