Как избежать Stack overflow? - Lisp

Формулировка задачи:

Следующий код хорошо работает для вызовов от единицы и от двойки, но от тройки и четверки я получаю Stack overflow. Что можно сделать, чтобы оптимизировать код, но при этом сильно не изменять его?

(route 1 '(2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) nil) //норм

(route 3 '(1 2 4 5 6 7 8 9 10 11 12 13 14 15 16) nil) //Stack overflow

Весь код программы:

 
(defvar production
 '( 
      (1 10) (1 7) 
      (2 9) (2 11) (2 8)
      (3 10) (3 12) (3 5)
      (4 6) (4 11)
      (5 11) (5 14) (5 3)
      (6 4) (6 12) (6 13) (6 15)
      (7 14) (7 16) (7 1) (7 9) 
      (8 2) (8 10) (8 15)
      (9 15) (9 7) (9 2)
      (10 16) (10 8) (10 1) (10 3)
      (11 2) (11 4) (11 5) (11 13)
      (12 3) (12 6) (12 14)
      (13 6) (13 11) 
      (14 5) (14 7) (14 12)
      (15 6) (15 8) (15 9)
      (16 7) (16 10)
  ))
 
(defun flatten (L)
(cond
((null L) nil)
((atom L) (list L))
(t (append (flatten (car L)) (flatten (cdr L))))))
 
(defun ableToUse (status)
   (mapcan
     #'(lambda (rule)
       (if (eq status (car rule)) (flatten (list (cdr rule))) nil))
         production
))

(defun route (currentSt haventBeen lastSt)
 (cond
   ( (null haventBeen) nil)
   ((and (not (eq (first (ableToUse currentSt)) lastSt )) (member (first (ableToUse currentSt)) haventBeen))
           (cons (first (ableToUse currentSt)) (route (first (ableToUse currentSt)) (remove (first (ableToUse currentSt))  haventBeen) currentSt)))
   ((and (not (eq (second (ableToUse currentSt)) lastSt )) (member (second (ableToUse currentSt)) haventBeen))
           (cons (second (ableToUse currentSt)) (route (second (ableToUse currentSt)) (remove (second (ableToUse currentSt))  haventBeen) currentSt)))
   ((and (not (eq (third (ableToUse currentSt)) lastSt )) (member (third (ableToUse currentSt)) haventBeen))
           (cons (third (ableToUse currentSt)) (route (third (ableToUse currentSt)) (remove (third (ableToUse currentSt))  haventBeen) currentSt)))
   ((and (not (eq (fourth (ableToUse currentSt)) lastSt )) (member (fourth (ableToUse currentSt)) haventBeen))
           (cons (fourth (ableToUse currentSt)) (route (fourth (ableToUse currentSt)) (remove (fourth (ableToUse currentSt))  haventBeen) currentSt)))
   (t (cons (car (remove lastSt (ableToUse currentSt))) (route (car (remove lastSt (ableToUse currentSt))) haventBeen currentSt)))))  

(route 3 '(1 2 4 5 6 7 8 9 10 11 12 13 14 15 16) nil)

Решение задачи: «Как избежать Stack overflow?»

Листинг программы

(defvar production
 '( 
      (1 7) (1 10) 
      (2 8) (2 9) (2 11)
      (3 5)(3 10) (3 12) 
      (4 6) (4 11)
      (5 3) (5 11) (5 14) 
      (6 4) (6 12) (6 13) (6 15)
      (7 1) (7 9) (7 14) (7 16) 
      (8 2) (8 10)(8 15)
      (9 2) (9 7) (9 15) 
      (10 1) (10 3) (10 8) (10 16)
      (11 2) (11 4) (11 5) (11 13)
      (12 3) (12 6) (12 14)
      (13 6) (13 11) 
      (14 5) (14 7) (14 12)
      (15 6) (15 8) (15 9)
      (16 7) (16 10)
  ))
 
(defun flatten (L)
(cond
((null L) nil)
((atom L) (list L))
(t (append (flatten (car L)) (flatten (cdr L))))))
 
(defun ffife (L)
 (remove nil (list (first L) (second L) (third L) (fourth L) (fifth L))))
(print (ffife '(1)))
 
 
 
(defun ableToUse (status)
   (mapcan
     #'(lambda (rule)
       (if (eq status (car rule)) (flatten (list (cdr rule))) nil))
         production
))
 
 
(defun route (currentSt haventBeen lastSt)
 (cond
   ( (null haventBeen) nil)
   ((and (not (eq (first (ableToUse currentSt)) lastSt )) (member (first (ableToUse currentSt)) haventBeen))
           (cons (first (ableToUse currentSt)) (route (first (ableToUse currentSt)) (remove (first (ableToUse currentSt))  haventBeen) currentSt)))
   ((and (not (eq (second (ableToUse currentSt)) lastSt )) (member (second (ableToUse currentSt)) haventBeen))
           (cons (second (ableToUse currentSt)) (route (second (ableToUse currentSt)) (remove (second (ableToUse currentSt))  haventBeen) currentSt)))
   ((and (not (eq (third (ableToUse currentSt)) lastSt )) (member (third (ableToUse currentSt)) haventBeen))
           (cons (third (ableToUse currentSt)) (route (third (ableToUse currentSt)) (remove (third (ableToUse currentSt))  haventBeen) currentSt)))
   ((and (not (eq (fourth (ableToUse currentSt)) lastSt )) (member (fourth (ableToUse currentSt)) haventBeen))
           (cons (fourth (ableToUse currentSt)) (route (fourth (ableToUse currentSt)) (remove (fourth (ableToUse currentSt))  haventBeen) currentSt)))
   (t (and (setq r (nth (random (length (remove lastSt (ableToUse currentSt)))) (remove lastSt (ableToUse currentSt)))) (cons r (route r haventBeen currentSt))))))
 
 
(print (route 4 '(1 2 3 5 6 7 8 9 10 11 12 13 14 15 16) nil))

Объяснение кода листинга программы

production - это список списков, представляющий собой граф или дерево, где каждый внутренний список представляет собой пару вершин, соединенных ребром.
Функция flatten используется для преобразования списка вложенных списков в одномерный список. Она работает путем рекурсивного вызова себя для каждой вершины в списке, пока все вершины не будут обработаны.
Функция ffife принимает список и возвращает список, содержащий только первые пять элементов этого списка.
Функция ableToUse принимает статус и список вершин и возвращает список вершин, которые могут быть достигнуты из начальной вершины с указанным статусом. Она делает это путем применения функции-обработчика к каждой вершине в списке и проверки, равен ли статус значению, связанному с этой вершиной.
Функция route принимает текущую вершину, список вершин, которые еще не были посещены, и последнюю посещенную вершину, и возвращает список вершин, которые могут быть достигнуты из текущей вершины. Она делает это путем применения функции-обработчика к каждой вершине в списке и проверки, может ли она быть достигнута из текущей вершины. Если это так, она добавляется в результирующий список. Если нет, функция выбирает случайную вершину из списка вершин, которые еще не были посещены, и передает ее в функцию route для дальнейшего рекурсивного вызова.
В конце кода вызывается функция route с аргументами 4, '(1 2 3 5 6 7 8 9 10 11 12 13 14 15 16) и nil. Это означает, что функция route должна начать с вершины 4 и обрабатывать все вершины в списке, пока не будет достигнута конечная вершина.