Ханойские башни в LispWorks

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

Здравствуйте, кто-нибудь знает как эту программу переделать, чтобы она работала в LispWorks???

(defn hanoi (n)
(print "ЗАДАЧА - ханойские башни, n = " n ":" \n)
 
(defn try-move (f t)
cond (null? f) false
(or (null? t) (< (car f) (car t))) (cons (cdr f) (cons (car f) t) nil)
false)
 
(defn steps (chain)
(match (car chain) '(a b c))
(def vars (cons
(cond (match (try-move a b) '(f t)) (cons f t c nil) nil)
(cond (match (try-move a c) '(f t)) (cons f b t nil) nil)
(cond (match (try-move b a) '(f t)) (cons t f c nil) nil)
(cond (match (try-move b c) '(f t)) (cons a f t nil) nil)
(cond (match (try-move c a) '(f t)) (cons t b f nil) nil)
(cond (match (try-move c b) '(f t)) (cons a t f nil) nil)
nil))
(def nexts (filter (lambda (x) not (null? x)) vars))
(map (lambda (n) cons n chain) (filter (lambda (v) not (elem v chain)) nexts)))
 
(defn solved? (state)
(match (car state) '(a b c))
(and (null? a) (null? b)))
 
(def start-state (cons (cons (list-from-to 1 n) nil nil nil) nil))
 
(defn show-line (l) foldl (lambda (x a) print x " ") 0 l)
(defn show-res (l i)
(print \n "Вариант " i ":" \n)
(defn go (l) cond (null? l) (+ i 1) ((show-line (car l)) (print \n) (go (cdr l)) ))
(go l))
 
(print "Поиск в глубину:")
(show-res (reverse (solve-depth steps solved? start-state)) 1)
 
(print \n "Поиск в ширину:" \n)
(foldl (lambda (l a) show-res (reverse l) a) 1 (solve-wide steps solved? start-state)) )

Решение задачи: «Ханойские башни в LispWorks»

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

(defn hanoi (n)
    (print "ЗАДАЧА - ханойские башни, n = " n ":" \n)

    (def memo (java (class "java.util.HashMap") "new"))

    (defn try-move (f t)
        cond (null? f) false
             (or (null? t) (< (car f) (car t))) (cons (cdr f) (cons (car f) t) nil)
             false)

    (defn get-key (l)
        (match l '(a b c))
        (++ (eval (cons ++ a)) "_" (eval (cons ++ b)) "_" (eval (cons ++ c)) ))

    (defn steps (chain)
        (match (car chain) '(a b c))
        (def vars (cons
            (cond (match (try-move a b) '(f t)) (cons f t c nil) nil)
            (cond (match (try-move a c) '(f t)) (cons f b t nil) nil)
            (cond (match (try-move b a) '(f t)) (cons t f c nil) nil)
            (cond (match (try-move b c) '(f t)) (cons a f t nil) nil)
            (cond (match (try-move c a) '(f t)) (cons t b f nil) nil)
            (cond (match (try-move c b) '(f t)) (cons a t f nil) nil)
            nil))
        (def nexts (filter
            (lambda (x) and (not (null? x)) (not (java memo "containsKey" (get-key x)))) vars))
        (foldl (lambda (x a) java memo "put" (get-key x) true) 0 nexts)
        (map (lambda (n) cons n chain) (filter (lambda (v) not (elem v chain)) nexts)) )

    (defn solved? (state)
        (match (car state) '(a b c))
        (and (null? a) (null? b)))

    (def start-state (cons (cons (list-from-to 1 n) nil nil nil) nil))

    (defn show-line (l) foldl (lambda (x a) print x "  ") 0 l)
    (defn show-res (l i)
        (print \n "Вариант " i ":" \n)
        (defn go (l) cond (null? l) (+ i 1) ((show-line (car l)) (print \n) (go (cdr l)) ))
        (go l))

    (print "Поиск в глубину:")
    (show-res (reverse (solve-depth steps solved? start-state)) 1)

    (def memo (java (class "java.util.HashMap") "new"))

    (print \n "Поиск в ширину:" \n)
    (foldl (lambda (l a) show-res (reverse l) a) 1 (solve-wide steps solved? start-state)) )

(hanoi 8)

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

Код решает задачу Ханойских башен с помощью рекурсивного бэктрекинга. Он использует стек для хранения текущего состояния, и если состояние уже было решено, он использует эту информацию, чтобы избежать повторных вычислений. Код состоит из следующих функций:

hanoi: Главная функция, которая задает начальное состояние, вычисляет решение и печатает его.
try-move: Функция, которая проверяет, можно ли переместить верхний диск из одного стержня на другой.
get-key: Функция, которая генерирует ключ для хранения состояния в хеше.
steps: Функция, которая генерирует последовательность ходов для решения задачи.
solved?: Функция, которая проверяет, является ли текущее состояние решением задачи.
start-state: Функция, которая создает начальное состояние.
show-line: Функция, которая печатает одну строку состояния.
show-res: Функция, которая печатает результат для определенного варианта.
solve-depth: Рекурсивная функция, которая решает задачу в глубину.
solve-wide: Рекурсивная функция, которая решает задачу в ширину. Список переменных и их значений:
n: Количество дисков
memo: Хеш для хранения уже вычисленных состояний.
a, b, c: Стержни (представлены как символы).
vars: Все возможные варианты состояний.
nexts: Варианты состояний, которые еще не были вычислены.
start-state: Начальное состояние.
show-line: Функция для печати одной строки состояния.
show-res: Функция для печати результата для определенного варианта.
solved?: Функция для проверки, является ли текущее состояние решением задачи.
try-move: Функция для проверки, можно ли переместить верхний диск из одного стержня на другой.
get-key: Функция для генерации ключа для хранения состояния в хеше.
steps: Функция для генерации последовательности ходов для решения задачи.
solve-depth: Рекурсивная функция для решения задачи в глубину.
solve-wide: Рекурсивная функция для решения задачи в ширину. Код сначала задает начальное состояние, затем вычисляет последовательность ходов для решения задачи и печатает результат. Затем он использует хеш memo для хранения уже вычисленных состояний, чтобы избежать повторных вычислений.