Решенные задачи 2.
Задачи на обработку списков (окончание)
Задача 22.
; ------------------------------------------------- ;
; Определить функцию 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))
))
Текст этой библиотеки можно взять здесь.
Задача 23.
; ------------------------------------------------- ;
; Проверить, являются ли два списка "конгруэнтными" ;
; (имеющими одинаковую структуру) ;
; Первый вариант решения ;
; ------------------------------------------------- ;
(DEFUN EQ_TYPE (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 (LST1 LST2)
(EQUAL (COPY LST1) (COPY LST2))
)
; ---------------------- ;
(DEFUN COPY (EXPN)
; Функция COPY возвращает копию структуры ;
; своего аргумента ;
(COND ( (ATOM EXPN) 1 )
( T (CONS (COPY (CAR EXPN))
(COPY (CDR EXPN))) )
)
)
Задача 24.
; -------------------------------------------- ;
; Найти сумму номеров заданной буквы в слове, ;
; введенном с клавиатуры ;
; -------------------------------------------- ;
(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) )
)
)
))
Текст этой библиотеки можно взять здесь.
Задача 25.
; ----------------------------------------------- ;
; Напишите функцию, удаляющую повторные вхождения ;
; элементов в список, например: ;
; (A B D D A) --> (A B D) ;
; ----------------------------------------------- ;
(DEFUN LIST-SET (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))) )
)
)
Задача 26.
; --------------------------------------------------- ;
; Напишите функцию 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))) )
)
))
Текст этой библиотеки можно взять здесь.
Задача 27.
; --------------------------------------- ;
; В списке переставьте первый и последний ;
; элементы местами ;
; --------------------------------------- ;
(DEFUN PERESTANOVKA (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))))))))
)
)
)
Задача 28.
; ----------------------------------------------- ;
; Определить функцию DISTL (распределение слева), ;
; действие которой рассмотрим на примере: ;
; (A (B C ... D)) --> ((A B) (A C) ... (A D)) ;
; ----------------------------------------------- ;
(DEFUN DISTL (LAMBDA (LST)
(AAA (CAR LST) (CADR LST))
))
; ---------------------- ;
(DEFUN AAA (X LST)
(COND ( (NULL LST) NIL)
( T (CONS (LIST X (CAR LST))
(AAA X (CDR LST))) )
)
)
Задача 29.
; ------------------------------------------------ ;
; Определить функцию DISTR (распределение справа), ;
; действие которой рассмотрим на примере: ;
; ((A B ... H) C) --> ((A C) (B C) ... (H C)) ;
; ------------------------------------------------ ;
(DEFUN (LAMBDA (LST)
(AAA (CAR LST) (CADR LST))
)
; ---------------------- ;
(DEFUN AAA (LST X)
(COND ( (NULL LST) NIL )
( T (CONS (LIST (CAR LST) X)
(AAA (CDR LST) X)) )
)
)
Задача 30.
; ---------------------------------------------- ;
; Описать функцию 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))) )
)
))
