文章/答案/技术大牛

发布

社区首页 >问答首页 >将代码从Lisp转换为方案

问将代码从Lisp转换为方案
EN

Stack Overflow用户

提问于 2018-06-06 05:39:05

回答 2查看 794关注 0票数 1

我有一个在通用Lisp中的工作程序，我也试图让它在Scheme中工作，但是它不起作用。这段代码是关于在名为vecino的estructure中进行深度优先搜索的。

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

我认为这是错误的，因为在方案中没有删除-如果用于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))

(A)

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

(A、C、G、K)

common-lisp

racket

scheme

lisp

回答 2

Stack Overflow用户

回答已采纳

发布于 2018-06-07 03:16:46

首先，非常感谢@coredump大大改进CL中的代码！

我把它转到球拍上了。

#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?

票数 3

Stack Overflow用户

发布于 2018-06-06 11:56:41

常见Lisp问题

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

使用*earmuffs*，即全局(特殊)变量周围的星号。此外，不要将setq与未定义的变量一起使用。见 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进行测试，测试“相同的非复合值”。如果不同的列表包含相同的元素，则返回零。此外，据我所知，代码并不是必要的，因为它包含在上一次测试中。

作为参考，这里是一个重写的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函数。您需要使用谓词的)。

票数 4

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/50712906

复制

相似问题

问将代码从Lisp转换为方案
EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问将代码从Lisp转换为方案EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问将代码从Lisp转换为方案
EN