Convert code from Lisp to SCHEME

Question

I have a working program in Common Lisp and I am trying to make it work in Scheme as well, but it is not working. The code is about depth-first search in the estructure called vecinos
Lisp Code:

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

Scheme code:

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

And I think this is what is wrong because in Scheme there is no remove-if that is used in the definition of 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))))
))

The result should be

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

(A)

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

(A C G K)

Answer 1

First of all, thank you very much @coredump to improve the code in CL substantially!

I transferred it to 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)))))

Small test:

(depth-first-search 'a 'a *graph*)
;; '(a)

(depth-first-search 'a 'k *graph*)
;; '(a c g k)

Some rules for transferring from CL to Racket (just a small subset of the rules, but which was sufficient for this example):

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

Common Lisp problems

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

Use *earmuffs*, i.e. asterisks around global (special) variables. Also, do not use setq with undefined variables. See 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))))))

The part marked as dead code is dead because member by default tests with eql, which tests for the "same non-compound value". With different lists holding the same elements, it returns nil. Besides, the code is not really necessary because it is included in the last test, as far as I know.

For reference, here is a rewritten CL implementation. The main difference is that each path is used as a stack: the original implementation kept appending at the end of the list, which requires a lot of traversal and produces a lot of allocation (the current implementation is still far from optimal in terms of ressource usage, but it is close to the original). The path is reversed at the end, only when necessary.

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

Racket defines a filter function which keeps elements satisfying a predicate. You need to use the complement (not?) of your predicate.