; ------------------------------------------------- ;
   ; Определить  функцию  LASTHALF, значением  которой ;
   ; должен быть список из последних n атомов в списке ;
   ; из  2n  атомов. Так, если  X  есть  (2 4 6 8), то ;
   ;      функция (LASTHALF X) возвращает (6 8)        ;
   ; ------------------------------------------------- ;
   (DEFUN LASTHALF (LAMBDA (LST)
      (COND ( (EQ (MOD (LENGTH LST) 2) 0)
                       (LASTN LST
                              (CAR (DIVIDE (LENGTH LST) 2))) )
            (  T  NIL  )
      )
   ))
   ; ------------------------- ;
   (DEFUN FIRSTN (LAMBDA (LST N)
   ; Выделяет в список первые N элементов списка LST ;
      (COND ( (EQ N 1) (LIST (CAR LST)) )
            ( T (CONS (CAR LST)
                      (FIRSTN (CDR LST) (- N 1))))
      )
   ))
   ; ------------------------ ;
   (DEFUN LASTN (LAMBDA (LST N)
   ; Выделяет в список последние N элементов списка LST ;
      (REVERSE (FIRSTN (REVERSE LST) N))
   ))

   ; ------------------------------------------------- ;
   ; Проверить, являются ли два списка "конгруэнтными" ;
   ;          (имеющими одинаковую структуру)          ;
   ;              Первый вариант решения               ;
   ; ------------------------------------------------- ;
   (DEFUN EQ_TYPE (LAMBDA (LST1 LST2)
      (COND
          ( (NOT (EQ (LENGTH LST1) (LENGTH LST2))) NIL )
          ( (AND (NULL LST1) (NULL LST2)) T )
          ( (AND (ATOM (CAR LST1)) (ATOM (CAR LST2)))
                       (EQ_TYPE (CDR LST1) (CDR LST2)) )
          ( (AND (NOT (ATOM (CAR LST1)))
                 (NOT (ATOM (CAR LST2))))
          (AND (EQ_TYPE (CAR LST1) (CAR LST2))
                       (EQ_TYPE (CDR LST1) (CDR LST2))) )
          ( T NIL )
      )
   ))
   ; ------------------------------------------------- ;
   ; Проверить, являются ли два списка "конгруэнтными" ;
   ;          (имеющими одинаковую структуру)          ;
   ;              Второй вариант решения               ;
   ; ------------------------------------------------- ;
   (DEFUN MAIN (LAMBDA (LST1 LST2)
      (EQUAL (COPY LST1) (COPY LST2))
   ))
   ; ---------------------- ;
   (DEFUN COPY (LAMBDA (EXPN)
   ; Функция COPY возвращает копию структуры ;
   ;            своего аргумента             ;
      (COND ( (ATOM EXPN) 1 )
            (   T  (CONS (COPY (CAR EXPN))
                         (COPY (CDR EXPN))) )
      )
   ))

   ; -------------------------------------------- ;
   ;  Найти сумму номеров заданной буквы в слове, ;
   ;            введенном с клавиатуры            ;
   ; -------------------------------------------- ;
   (DEFUN MAIN (LAMBDA ()
      (PRIN1 "Введите слово... ")
      (SETQ F (UNPACK (READ)))
      (PRIN1 "Введите букву... ")
      (SUMMA (READ)
             (PAIRLIS F (REVERSE (NUMER (LENGTH F))) NIL))
   ))
   ; ------------------------ ;
   (DEFUN SUMMA (LAMBDA (X LST)
      (COND ( (NULL LST) 0 )
            ( (EQ X (CAAR LST))
                    (+ (CADR (CAR LST))
                       (SUMMA X (CDR LST))) )
            (  T  (SUMMA X (CDR LST)) )
      )
   ))
   ; -------------------- ;
   (DEFUN NUMER (LAMBDA (N)
   ; Построение списка (1 2 3 ... N) ;
      (COND
         ( (EQ N 0) NIL )
         (    T    (CONS N (NUMER (- N 1)))  )
      )
   ))
   ; ----------------------------------- ;
   (DEFUN PAIRLIS (LAMBDA (KEY DATA ALIST)
   ; Построение A-списка из списка ключей KEY и списка ;
   ; данных DATA путем  добавления новых пар к сущест- ;
   ;                 вующему списку ALIST              ;
      (COND ( (NULL KEY)  ALIST )
            ( (NULL DATA) ALIST )
            (  T  (CONS (CONS (CAR KEY) (CAR DATA))
                        (PAIRLIS
                           (CDR KEY) (CDR DATA) ALIST) )
            )
      )
   ))

   ; ----------------------------------------------- ;
   ; Напишите функцию, удаляющую повторные вхождения ;
   ; элементов в список, например:                   ;
   ;             (A B D D A) --> (A B D)             ;
   ; ----------------------------------------------- ;
   (DEFUN LIST-SET (LAMBDA (LST)
   ; Функция LIST-SET преобразует список LST в множество ;
      (COND
         ( (NULL LST) NIL )
         ( (MEMBER (CAR LST) (CDR LST))
                     (LIST-SET (CDR LST)) )
         (    T   (CONS (CAR LST) (LIST-SET (CDR LST))) )
      )
   ))

   ; --------------------------------------------------- ;
   ; Напишите функцию TOP, такую, что (TOP L) возвращает ;
   ; максимальную глубину  подсписков списка L.          ;
   ; Так, если L есть (1 4 (2 6 (3 7) 8)), то (TOP L)    ;
   ;                   возвращает 3                      ;
   ; --------------------------------------------------- ;
   (DEFUN TOP (LAMBDA (LST)
      (COND
         ( (ALLATOMP LST) 1 )
         (  T  (MAX (+ 1 (TOP (CAR LST)))
                    (TOP (CDR LST))) )
      )
   ))
   ; -------------------- ;
   (DEFUN MAX (LAMBDA (M N)
   ; Функция MAX возвращает большее из двух чисел ;
      (COND ( (> M N) M )
            (  T      N )
      )
   ))
   ; ------------------------- ;
   (DEFUN ALLATOMP (LAMBDA (LST)
   ; Предикат, позволяющий установить, являются ли ;
   ;         все элементы списка LST атомами       ;
      (COND
          ( (NULL LST)  T                                  )
          (  T (AND (ATOM (CAR LST)) (ALLATOMP (CDR LST))) )
      )
   ))

   ; --------------------------------------- ;
   ; В списке переставьте первый и последний ;
   ;           элементы местами              ;
   ; --------------------------------------- ;
   (DEFUN PERESTANOVKA (LAMBDA (LST)
      (COND ( (NULL LST) NIL )
            ( (EQ (LENGTH LST) 1) LST )
            ( T  (REVERSE
                    (CONS (CAR LST)
                    (REVERSE (CONS (CAR (REVERSE LST))
                    (REVERSE (CDR (REVERSE (CDR LST))))))))
            )
      )
   ))

   ; ----------------------------------------------- ;
   ; Определить функцию DISTL (распределение слева), ;
   ; действие которой рассмотрим на примере:         ;
   ;   (A (B C ... D)) --> ((A B) (A C) ... (A D))   ;
   ; ----------------------------------------------- ;
   (DEFUN DISTL (LAMBDA (LST)
      (AAA (CAR LST) (CADR LST))
   ))
   ; ---------------------- ;
   (DEFUN AAA (LAMBDA (X LST)
      (COND ( (NULL LST) NIL)
            (    T   (CONS (LIST X (CAR LST))
                           (AAA X (CDR LST))) )
      )
   ))

   ; ------------------------------------------------ ;
   ; Определить функцию DISTR (распределение справа), ;
   ; действие которой рассмотрим на примере:          ;
   ;   ((A B ... H) C) --> ((A C) (B C) ... (H C))    ;
   ; ------------------------------------------------ ;
   (DEFUN DISTR (LAMBDA (LST)
      (AAA (CAR LST) (CADR LST))
   ))
   ; ---------------------- ;
   (DEFUN AAA (LAMBDA (LST X)
      (COND ( (NULL LST) NIL )
            (   T  (CONS (LIST (CAR LST) X)
                         (AAA (CDR LST) X)) )
      )
   ))

   ; ---------------------------------------------- ;
   ; Описать функцию  SP, которая переписывает  все ;
   ; элементы, не равные X в начало, а равные X -   ;
   ;            в конец данного списка              ;
   ; --------------------------------------------- ;
   (DEFUN SP (LAMBDA (X LST)
      (COND ( (NULL LST) NIL )
            (  T   (APPEND (REMBER X LST)
                           (COPY X (KOL X LST))) )
      )
   ))
   ; ---------------------- ;
   (DEFUN KOL (LAMBDA (X LST)
   ; Подсчет количества повторений элемента X ;
   ;             в списке LST                 ;
      (COND ( (NULL LST) 0 )
            ( (EQ (CAR LST) X)
                 (+ (KOL X (CDR LST)) 1) )
            (  T  (KOL X (CDR LST))   )
      )
   ))
   ; ------------------------- ;
   (DEFUN REMBER (LAMBDA (X LST)
      (COND ((NULL LST) NIL)
            ( (EQ X (CAR LST)) (REMBER X (CDR LST)) )
            (  T   (CONS (CAR LST)
                         (REMBER X (CDR LST))) )
      )
   ))
   ; --------------------- ;
   (DEFUN COPY (LAMBDA (X N)
   ; Функция, позволяющая копировать N раз данный ;
   ;               элемент в список               ;
      (COND ( (EQUAL N 0) NIL )
            (  T  (CONS X (COPY X (- N 1))) )
      )
   ))

   ; ------------------------------------------------- ;
   ; Отыскать в списке такой атом, который встречается ;
   ;             за один атом перед заданным           ;
   ; ------------------------------------------------- ;
   (DEFUN PATOM (LAMBDA (X LST)
      (COND ( (NULL LST) NIL )
            ( (< (LENGTH LST) 3) NIL )
            (  T  (NTH (- (NATOM X LST) 2)
                       LST) )
       )
   ))
   ; ---------------------- ;
   (DEFUN NTH (LAMBDA (N LST)
   ; Функция возвращает N-й элемент списка LST ;
      (COND ( (< N 1) 0 )
            ( (EQ N 1) (CAR LST) )
            (   T   (NTH (- N 1) (CDR LST)) )
      )
   ))
   ; ------------------------ ;
   (DEFUN NATOM (LAMBDA (X LST)
   ; Функция возвращает позицию заданного элемента ;
      (COND ( (NULL LST) 0)
            ( (EQ X (CAR LST)) 1)
            ( (MEMBER X LST) (+ 1 (NATOM X (CDR LST))) )
            ( T  0 )
      )
   ))

   ; -------------------------------------------- ;
   ; Напишите функцию INSLIST, зависящую от трех  ;
   ; аргументов N, U и V, вставляющую в список U, ;
   ;        начиная с N-го элемента список V      ;
   ; -------------------------------------------- ;
   (DEFUN MAIN (LAMBDA (LST1 N LST2)
      (COND ( (EQ (LENGTH LST1) N) (APPEND LST1 LST2) )
            (  T  (APPEND (FIRSTN LST1 N)
                          (APPEND LST2
                                 (LASTN LST1
                                        (-
                                           (LENGTH LST1) N)))
                  )
            )
      )
   ))
   ; ------------------------- ;
   (DEFUN FIRSTN (LAMBDA (LST N)
   ; Выделяет в список первые N элементов списка LST ;
      (COND ( (EQ N 1) (LIST (CAR LST)) )
            (  T  (CONS (CAR LST)
                        (FIRSTN (CDR LST)
                                (- N 1))))
      )
   ))
   ; ------------------------ ;
   (DEFUN LASTN (LAMBDA (LST N)
   ; Выделяет в список последние N элементов списка LST ;
      (REVERSE (FIRSTN (REVERSE LST) N))
   ))
   ; ----------------------------- ;
   (DEFUN APPEND (LAMBDA (LST1 LST2)
   ; Составляет список из первых N элементов спискa LST1 ;
   ;              и вставляемого списка LST2             ;
      (COND ( (NULL LST1) LST2 )
            (   T  (CONS (CAR LST1)
                         (APPEND (CDR LST1) LST2) ))
      )
   ))

   ; ----------------------------------------------------- ;
   ; Составить список, конгруэнтный данному и состоящий из ;
   ;  глубин погружения каждого элемента исходного списка  ;
   ; ----------------------------------------------------- ;
   (DEFUN AA (LAMBDA (LST)
      (AA1 1 LST)
   ))
   ; ---------------------- ;
   (DEFUN AA1 (LAMBDA (N LST)
      (COND ( (NULL LST) NIL)
            (  T  (CONS (GETN N (CAR LST))
                        (AA1 N (CDR LST))) )
      )
   ))
   ; ---------------------- ;
   (DEFUN GETN (LAMBDA (N LS)
      (COND  ( (ATOM LS) N )
             ( T (COND ( (< (LENGTH LS) 2)
                           (LIST (GETN (+ 1 N)
                                       (CAR LS))) )
                         ( T  (AA1 (+ 1 N) LS) )
                 )
             )
      )
   ))

   ; ------------------------------------------------- ;
   ; Функция, преобразует список чисел в список чисел, ;
   ;       встречающихся в нем более одного раза       ;
   ; ------------------------------------------------- ;
   (DEFUN KOLAM (LAMBDA (LST)
      (EL (LIST-SET (TH LST LST)))
   ))
   ; ------------------- ;
   (DEFUN EL (LAMBDA (LST)
      (COND
         ( (NULL LST) NIL )
         ( (>; (CADR (CAR LST)) 1)
              (CONS (CAR (CAR LST)) (EL (CDR LST))) )
         (  T  (EL (CDR LST)) )
      )
   ))
   ; ------------------------- ;
   (DEFUN LIST-SET (LAMBDA (LST)
   ; Функция LIST-SET преобразует список LST в множество ;
      (COND ( (NULL LST) NIL )
            ( (MEMBER (CAR LST) (CDR LST))
                 (LIST-SET (CDR LST)) )
            (  T  (CONS (CAR LST) (LIST-SET (CDR LST))) )
      )
   ))
   ; ------------------------ ;
   (DEFUN TH (LAMBDA (LST LST0)
   ; Построение нового  списка, содержащего  подсписки  вида ;
   ; (Элемент Количество_повторений_этого_элемента_в_списке) ;
      (COND ( (NULL LST) NIL)
            (  T  (CONS (LIST (CAR LST)
                              (KOL (CAR LST) LST0))
                        (TH (CDR LST) LST0)) )
      )
   ))
   ; ---------------------- ;
   (DEFUN KOL (LAMBDA (M LST)
   ; Подсчет количества повторений элемента M в списке LST ;
      (COND ( (NULL LST) 0 )
            ( (EQ (CAR LST) M)
                 (+ (KOL M (CDR LST)) 1) )
            (  T  (KOL M (CDR LST)) )
      )
   ))

   ; ----------------------------------------------------- ;
   ; Проверить, встречаются ли в данном предложении слова, ;
   ; являющиеся "перевертышами" первого слова предложения  ;
   ; ----------------------------------------------------- ;
   (DEFUN MAIN (LAMBDA (LST)
      (COND ( (NULL LST) NIL )
            (  T  (OR (WWWW (CAR LST)
                            (COPYINVERT (CDR LST)))
                      (MAIN (CDR LST))
                  )
            )
      )
   ))
   ; ----------------------- ;
   (DEFUN WWWW (LAMBDA (X LST)
      (COND ( (NULL LST) NIL )
            ( (MEMBER X LST) T )
            (   T  (WWWW (CDR LST)) )
      )
   ))
   ; --------------------------- ;
   (DEFUN COPYINVERT (LAMBDA (LST)
      (COND ( (NULL LST) NIL )
            ( T (CONS (PACK (REVERSE (UNPACK (CAR LST))))
                        (COPYINVERT (CDR LST))
                )
            )
      )
   ))

   ; --------------------------------------------------- ;
   ; Написать программу перевода целого N в целое число, ;
   ; запись которого отличается от записи числа N пере-  ;
   ;         становкой первой и последней цифр           ;
   ; --------------------------------------------------- ;
   (DEFUN PER (LAMBDA (N)
      (SETQ L (UNPACK N))
      (COND ( (< N 10) N )
            ( T (NUMBER (STRING-NUM
                            (APPEND
                               (LIST (CAR (REVERSE L)))
                               (REVERSE
                                  (CDR (REVERSE (CDR L))))
                               (CAR L))
                        )
                )
            )
      )
   ))
   ; ------------------------- ;
   (DEFUN STRING-NUM (LAMBDA (X)
   ; Перевод списка цифр в список, содержащий ;
   ;     соответствующие однозначные числа    ;
      (COND ( (NULL X) NIL )
            (  T  (CONS (POSITION (CAR X) (UNPACK 123456789))
                        (STRING-NUM (CDR X))
                  )
            )
      )
   ))
   ; ---------------------------- ;
   (DEFUN  POSITION (LAMBDA (X LST)
   ; Функция  POSITION  возвращает  положение атома X ;
   ; в одноуровневом списке LST (первый элемент имеет ;
   ; номер 1). Если элемента в списке нет, то функция ;
   ;                возвращает 0                      ;
      (COND ( (NULL LST)       0 )
            ( (EQ X (CAR LST)) 1 )
            ( (MEMBER X LST)
                 (+ 1 (POSITION X (CDR LST))) )
            ( T  0 )
      )
   ))
   ; ----------------------- ;
   (DEFUN NUMBER (LAMBDA (LST)
   ; Дан числовой список LST, содержащий однозначные числа. ;
   ;  "Построить" целое число из элементов данного списка   ;
     (COND ( (NULL LST) 0 )
           (  T  (+ (* (CAR LST)
                            (STEPEN 10
                                 (- (LENGTH LST) 1))
                       )
                       (NUMBER (CDR LST))
                 )
           )
     )
   ))
   ; ----------------------- ;
   (DEFUN STEPEN (LAMBDA (X A)
   ; Возведение целого числа X в целую ;
   ;     неотрицательную степень A     ;
      (COND ( (ZEROP A) 1 )
            ( (ZEROP (- A 1)) X )
            (  T  (* (STEPEN X (- A 1)) X) )
      )
   ))

   ; ----------------------------------------------- ;
   ; Попытайтесь восстановить условие данной задачи! ;
   ; ----------------------------------------------- ;
   (DEFUN AAA (LAMBDA (Y LST)
      (SETQ W (COPY LST LST Y))
      (COPY1 W W)
   ))
   ; ---------------------------- ;
   (DEFUN COPY (LAMBDA (LST LST1 Y)
   ; Построение списка, конгруэнтного списку  LST и ;
   ; содержащего символы вида G*** вместо вхождений ;
   ;                   символов Y                   ;
      (COND ( (NULL LST) NIL )
            ( (AND (ATOM LST) (EQ LST Y))  (GENSYM) )
            ( (AND (ATOM LST) (NOT (EQ LST Y))) LST )
            (  T  (CONS (COPY (CAR LST) LST1 Y)
                        (COPY (CDR LST) LST1 Y)
                  )
            )
      )
   ))
   ; --------------------------- ;
   (DEFUN COPY1 (LAMBDA (LST LST1)
   ; Построение списка, конгруэнтного списку LST и ;
   ; содержащего "глубины погружения" элементов в  ;
   ;        список LST вместо символов G***        ;
      (COND ( (NULL LST) NIL )
            ( (AND (ATOM LST) (EQ (CAR (UNPACK LST)) G))
                                      (POISK LST LST1) )
            ( (AND (ATOM LST) (NOT (EQ (CAR (UNPACK LST)) G)))
                                      LST )
            (  T  (CONS (COPY1 (CAR LST) LST1)
                        (COPY1 (CDR LST) LST1)) )
      )
   ))
   ; ----------- ;
   (SETQ GENSYM 0)
   (DEFUN GENSYM (LAMBDA (NUM LST)
      (SETQ NUM (- 4 (LENGTH GENSYM)))
      (LOOP
         ( (ZEROP NUM) )
         ( PUSH 0 LST )
         ( SETQ NUM (- NUM 1)) )
      (PROG1
         (PACK (NCONC (CONS (QUOTE G) LST) (LIST GENSYM)))
         (SETQ GENSYM (+ GENSYM 1))
      )
   ))
   ; ------------------------ ;
   (DEFUN POISK (LAMBDA (X LST)
   ; Нахождение "глубины погружения" X в список LST ;
      (COND ( (MEMBER X LST) 1 )
            ( (MEMBER2 X (CAR LST))
                  (+ 1 (POISK X (CAR LST))) )
            (  T  (POISK X (CDR LST)) )
      )
   ))
   ; -------------------------- ;
   (DEFUN MEMBER2 (LAMBDA (X LST)
   ; Предикат MEMBER2 устанавливает вхождение ;
   ;  элемента X в многоуровневый список LST  ;
      (COND ( (NULL LST) NIL)
            (  T  (OR (COND ( (ATOM (CAR LST))
                                 (EQ X (CAR LST)) )
                            (  T  (MEMBER2 X (CAR LST)) )
                      )
                      (MEMBER2 X (CDR LST))) )
      )
   ))