Дана схема метрополитена, найти кратчайший путь между станциями

(defun delit (seq i)
  ((lambda (del)
    (setq del '(lambda (seq i c len)
      (cond ((= c len) ())
            ((member c i) (apply del (list (cdr seq) i (1+ c) len)))
            (t (cons (car seq) (apply del (list (cdr seq) i (1+ c) len)))))))
    (apply del (list seq i 0 (length seq)))) ()))
 
Команда:
(delit '(0 1 2 3 4 5 6 7 8 9) '(4 0 9))
; (1 2 3 5 6 7 8)

(defun Sum (n)
  (if (= n 0)
      0
      (+ n (Sum (1- n)))))
 
(Sum 5)
; 15

(defun foo (n / local-fun)
  (setq local-fun (lambda (x)
                    (if (= x 0) 0
                      (+ x (local-fun (- x 1))))))
  (local-fun n))

(defun DIJKSTRA (Net_name Net_dist Init Term &optional (Tmp nil) (Fix (list (cons Init 0))))
 ((lambda (fix_label fix_value)
   (if (equal fix_label Term)
    (cons
     fix_value
     (SHORTEST_CHAIN (mapcar 'cons Net_name (apply 'mapcar (cons 'LIST Net_dist))) Init Term Fix))
    (apply 
     #'(lambda (newTmp newFix)
      (if (equal newFix Fix)
       nil ; unresolvable situation
       (DIJKSTRA Net_name Net_dist Init Term newTmp newFix)))
     (TRANSFER_MIN
      (UPDATE_Tmp
       Tmp
       Fix
       (mapcar 'cons
        Net_name
        (cdr
         (assoc
          fix_label
          (mapcar 'cons Net_name Net_dist)
          :test 'EQUAL))))
      Fix))))
  (caar Fix)
  (cdar Fix)))

(defun UPDATE_Tmp (Tmp Fix Links)
 (if Links
  ((lambda (link_label link_value)
    (UPDATE_Tmp
     (if link_value
      (if (assoc link_label Fix :test 'EQUAL) Tmp
       ((lambda (link mark)
         (if link
          (subst (cons link_label (min mark (cdr link))) link Tmp :test 'EQUAL)
          (cons (cons link_label mark) Tmp)))
        (assoc link_label Tmp :test 'EQUAL)
        (+ link_value (cdar Fix))))
      Tmp)
     Fix
     (cdr Links)))
   (caar Links)
   (cdar Links))
  Tmp))

(defun TRANSFER_MIN (Tmp Fix)
 (if Tmp
  (if (cdr Tmp)
   (apply
    #'(lambda (elem newTmp newFix)
     (if (< (cdr elem) (cdar newFix))
      (list
       (cons (car newFix) newTmp)
       (cons elem (cdr newFix)))
      (list
       (cons elem newTmp)
       newFix)))
    (cons (car Tmp) (TRANSFER_MIN (cdr Tmp) Fix)))
   (list
    (cdr Tmp)
    (cons (car Tmp) Fix)))
  (list Tmp Fix)))

(defun SHORTEST_CHAIN (Net_link Init Term Fix &optional (Routes (list (list Term))))
 (if Routes
  ((lambda (route result)
    ((lambda (head)
      (if (equal head Init)
       (cons route result)
       (append
        (SHORTEST_CHAIN
         Net_link
         Init
         Term
         Fix
         (mapcar
          #'(lambda (node) (cons node route))
          (apply 'append
           (mapcar
            #'(lambda (node)
             ((lambda (name dist)
               (if dist
                ((lambda (head_mark name_mark)
                  (if (and head_mark name_mark)
                   (if (= (- (cdr head_mark) (cdr name_mark)) dist)
                    (cons name nil))))
                 (assoc head Fix :test 'EQUAL)
                 (assoc name Fix :test 'EQUAL))))
              (car node)
              (cdr node)))
            (mapcar 'cons
             (mapcar 'car Net_link)
             (cdr (assoc head Net_link :test 'EQUAL)))))))
        result)))
     (car route)))
   (car Routes)
   (SHORTEST_CHAIN Net_link Init Term Fix (cdr Routes)))))

(setq Net_name '("1" "2" "3" "4" "5" "6"))
(setq Net_dist
'((nil 3 7 nil nil nil)
  (1 nil 2 nil nil 1)
  (nil 1 nil 2 4 nil)
  (nil nil nil nil 1 5)
  (nil nil 1 nil nil 3)
  (nil nil nil 2 nil nil)))

(DIJKSTRA Net_name Net_dist "1" "5")

(setq Net_name '("A" "B" "C" "D"))
(setq Net_dist
'((nil 5 4 nil)
  (nil nil 1 4)
  (nil 1 nil 5)
  (nil nil nil nil)))

(DIJKSTRA Net_name Net_dist "A" "D")

;;; Алгоритм Дейкстры для нахождения кратчайших путей.
(defun Dijkstra (net begin end)
  (let* ((current-node begin)
         ;; Make-Queue.
         (HQ (mapcar #'(lambda (x) (list x 'Inf nil))
                    (remove begin (mapcar #'car net) :test #'equalp)))
         (Path (list (list begin 0 nil))))
    ;; Проверка корректности данных.
    (when (set-difference (list begin end) (mapcar #'car net) :test #'equalp)
      (return-from dijkstra "These vertices do not correspond to the net."))
    ;; Вставка меток/уменьшение ключа/удаление вершин в цикле.
    (loop (if (or (null HQ)
                  (equalp current-node end))
              (return (Tracing Path end)))  ; возвращаемое значение
      ;; Insert.
      (let ((curr-num (cadar Path))
            (keys (mapcar #'car (cdr (assoc current-node net :test #'equalp)))))
        (dolist (neighbor keys)
          (let ((neig-struct (assoc neighbor HQ :test #'equalp))
                (neig-number  ;; Selection from net.
                      (cdr (assoc neighbor
                             (cdr (assoc current-node net :test #'equalp))
                             :test #'equalp))))
            (if neig-struct
                (if (or (eq 'Inf (second neig-struct))
                        (< (+ neig-number curr-num) (second neig-struct)))
                    (setf (second neig-struct)
                          (+ neig-number
                             curr-num)
                          (third neig-struct)
                          current-node))))))
      ;; Decrease-Key.
      (let ((del (car (sort (copy-list (remove-if-not #'numberp HQ :key #'second))
                           #'< :key #'second))))
        ;; Delete-Min.
        (setq HQ (remove del HQ :test #'equalp))
        (push del Path)
        (setq current-node (caar path))))))
 
;;; Отследить путь обратно.
(defun Tracing (path end)
  (let* ((order-node (assoc end path :test #'equalp))
         (len (second order-node))
         (next-node (third order-node))
         (way ()))
    (push order-node way)
    (setq path (remove order-node path :test #'equalp))
    (loop
      (cond
        ((not next-node) (return (values (mapcar #'car way) len)))
        ((null path) (return "No solution.")))
      (setq order-node (assoc next-node path :test #'equalp)
            next-node (third order-node))
      (push order-node way)
      (setq path (remove order-node path :test #'equalp)))))
 
;; Сеть, список смежности: (узел (соседний_узел . длина_дуги)
(defparameter  *net*
  '(("1" ("2" .  300) ("6" .  550) ("5" . 1345))
    ("2" ("1" .  300) ("3" . 1400))
    ("3" ("4" .  300) ("2" . 1400))
    ("4" ("3" .  300) ("7" .  550) ("5" . 1345))
    ("5" ("4" . 1345) ("1" . 1345))
    ("6" ("1" .  550) ("7" . 1100))
    ("7" ("4" .  550) ("6" . 1100))))
 
> (Dijkstra *net* "1" "4")
("1" "2" "3" "4")
2000