Работа со списками - Lisp (229327)

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

Здравствуйте! Выполняю лабораторную по Lisp'у. Задание следующее:

Дан глобальный список ORDINE_ATOMI, который фиксирует порядок атомов. 1. Объявить функцию из 2х переменных (ORDINE atom1 atom2), где она истинна только тогда, когда атом1 следует перед атомом2 в списке ORDINE_ATOMI. 2. Объявить функцию 1 переменной (ORD_LISTA L), которая упорядочивает элементы из списка L согласно порядку в списке ORDINE_ATOMI.

По первому пункту написала следующее:

(setq *ORDINE_ATOMI* '(1 2 3 4 5 6 7 8 9))
 
(defun pos_num (x lst &optional (pos 0))
       (cond
         ((eql x (car lst)) pos)
         (t (pos_num x (cdr lst) (1+  pos)))))
 
(defun ORDINE (x y)
       (cond
         ((> (pos_num x ORDINE_ATOMI) (pos_num y ORDINE_ATOMI)) "FALSE")
         (t "TRUE")))

Т.е. Нахожу позицию одного элемента, другого элемента, сравниваю эти позиции. Синтаксис учу только 2ую неделю, в основном, есть догадки, каким образом можно было бы реализовать программу, но знаний синтаксиса не хватает, приходится выкручиваться... Если есть другие идеи, поделитесь пожалуйста.

Решение задачи: «Работа со списками»

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

(setq *ordlist* '(a b c d e f))
 
==> (A B C D E F)
;; Создана глобальная переменная *ordlist*
 
(defun ordin (a1 a2 alst &optional (p1 nil) (p2 nil))
  (cond ((null alst) nil)
        ((eq (car alst) a1) (if p2 nil (ordin a1 a2 (cdr alst) t p2)))
        ((eq (car alst) a2) (if p1 t nil))
        (t (ordin a1 a2 (cdr alst) p1 p2))))
 
==> ORDIN
 
(defun asort (lst)
  (cond ((null lst) nil)
        (t (let ((z (car lst)))
             (append (asort (remove-if-not (lambda (x) (ordin x z *ordlist*)) (cdr lst)))
                     (list z)
                     (asort (remove-if (lambda (x) (ordin x z *ordlist*)) (cdr lst))))))))
 
==> ASORT
 
(asort '(a f b c c c a a b f f a))
 
==> (A A A A B B C C C F F F)

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

Создана глобальная переменная ordlist со значением '(a b c d e f).
Определена функция ordin с тремя аргументами a1, a2, alst и двумя опциональными аргументами p1 и p2, которые по умолчанию равны nil.
Если alst равно nil, то функция возвращает nil.
Если (car alst) равно a1, то выполняется рекурсивный вызов функции ordin с аргументами a1, a2, (cdr alst) и (p1, p2), причем значение p2 изменяется на t, если p1 не равно nil.
Если (car alst) равно a2, то значение p1 устанавливается в t, если p1 не равно nil.
В противном случае выполняется рекурсивный вызов функции ordin с аргументами a1, a2, (cdr alst), (p1, p2).
Определена функция asort с одним аргументом lst.
Если lst равно nil, то функция возвращает nil.
В противном случае выполняется вызов функции ordin с аргументами (car lst), (cdr lst), ordlist.
Выполняется рекурсивный вызов функции asort с аргументом (remove-if-not (lambda (x) (ordin x (car lst) ordlist)) (cdr lst)).
К результату рекурсивного вызова функции asort добавляется (car lst).
К результату рекурсивного вызова функции asort добавляется (asort (remove-if (lambda (x) (ordin x (car lst) ordlist)) (cdr lst)).
Выполняется вызов функции asort с аргументом '(a f b c c a a b f f a)).
Результатом является '(A A A A B B C C C F F F).