Lisp Stack overflow recursive function

Question

I am creating a heuristic function and it returns what it is supposed to but also there is a stack overflow problem and I can't understand where is the problem. Here is the code of the functions i created:

(defun nextPositions (position)
  (let*((listaPosAdjacentes)
        (positionFinal position)
        (listaFinal NIL))
    (setf listaPosAdjacentes (possible-actions2))
    (dolist (posAdjacente listaPosAdjacentes)
      (setf positionFinal position)
      (setf positionFinal (list (+ (nth 0 positionFinal) (nth 0 posAdjacente))
                                (+ (nth 1 positionFinal) (nth 1 posAdjacente))))
      (push positionFinal listaFinal))
    listaFinal))

(defun push-unique (element lista)
  (let ((auxlist lista))
    (dolist (i lista)
      (if (and (equal (nth 0 i) (nth 0 element)) (equal (nth 1 i) (nth 1 element)))
          (return-from push-unique auxlist)))

    (push element auxlist)
    auxlist))

(defun recursive (track1 positionslist distance track)
  (let ((NextValidPositions NIL))
    (dolist (position positionslist)
      (if (equal (track-startpos track) position)
          (return-from recursive track1)
        (progn (dolist (i (nextPositions position))
                 (if (equal (nth (nth 1 i) (nth (nth 0 i) track1)) T)
                     (progn 
                       (setf NextValidPositions (push-unique i NextValidPositions))
                       (setf (nth (nth 1 i) (nth (nth 0 i) track1)) (+ 1 distance))))))))
    (recursive track1 NextValidPositions (+ 1 distance) track)))

(defun compute-heuristic(st)
  (let* ((track (state-track st))
         (distance 0)
         (track1Final nil)
         (track1heuristica (track-env track)))
    (dolist (position (track-endpositions track))
      (setf (nth (nth 1 position) (nth (nth 0 position) track1heuristica)) distance))
    (setf track1Final (recursive track1heuristica (track-endpositions track) distance track))
    (print track1Final)
    (return-from compute-heuristic track1Final)))

The result is the following:

The list it returns is what it is supposed to return but I can't understand the stack overflow problem.

The code is called like this:

  (format t "~&Exercise 3.1 - Heuristic~&")
  (with-open-file (str "out3.1.txt"
     :direction :input)
  (format t "~% Solution is correct? ~a~&" (equal (list (compute-heuristic (initial-state *t1*)) (compute-heuristic (make-state :pos '(1 6)  :track track)) (compute-heuristic (make-state :pos '(2 8)  :track track))) (read str))))

It is a local test and this code was provided by our professor to test our code and that's why I think the problem is not there.

Any ideas what the problem might be? Thanks.

Answer 1

About style :

Generally the code is not well written, since it uses too many control structures and variables which are not really needed.

Example:

(defun push-unique (element lista)
  (let ((auxlist lista))
    (dolist (i lista)
      (if (and (equal (nth 0 i)
                      (nth 0 element))
               (equal (nth 1 i)
                      (nth 1 element)))
          (return-from push-unique auxlist)))
    (push element auxlist)
    auxlist))

• unnecessary variable auxlist
• no dolist needed, use member
• no return-from needed, just return the value. In many case the use of return-from is a code smell , indicating too complicated code.
• no push needed, just return the result of cons

Better:

(defun push-unique (element list)
  (if (member element list
              :test (lambda (a b)
                      (and (equal (first a) (first b))
                           (equal (second a) (second b)))))
      list
      (cons element list)))

The functionality exists already

The function push-unique exists already in standard Common Lisp. It is called adjoin :

CL-USER 34 > (adjoin 1 '(2 3 4 1 3))
(2 3 4 1 3)

CL-USER 35 > (adjoin 1 '(2 3 4 3))
(1 2 3 4 3)

Just pass the right test function for your purpose...

(defun push-unique (element list)
  (adjoin element list
          :test (lambda (a b)
                  (and (equal (first a) (first b))
                       (equal (second a) (second b))))))

Comments & documentation

Probably it's also a good idea to write comments and documentation. Otherwise one has to guess/infer what the purpose of these functions is.