Search code examples
schemelispcommon-lispracket

Convert code from Lisp to SCHEME


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)


Solution

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