Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Лабораторные по Лисп.doc
Скачиваний:
6
Добавлен:
26.09.2019
Размер:
74.75 Кб
Скачать

Конструирующая рекурсия.

Задание 11: Сформировать список простых множителей заданного числа. Запускать (LMul ...).

(defun Simple( M TList) (cond ((Null TList) T) ((= 0 (rem M (car TList))) Nil) (T (Simple M (cdr TList))) ) )

(defun RunLMul (N M Temp) (if (= 2 M) (Setq Temp Nil) (SetQ Temp (RunLMul N (- M 1)))) (cond ((and (= 0 (rem N M)) (Simple M Temp)) (cons M Temp ) ) (T Temp) ) )

(defun LMul (N) (cond ((or (not (IntegerP N))(not ( PlusP N))) 'non-integer) ((= N 1) Nil) (T (RunLMul N N)) ) ) (rds)

-----------------------------------------------------------------

Задание 12: Реверсировать элементы списка произвольной структуры на всех уровнях. Запускать (RevL ...).

(defun GoRev (L) (cond ((Null L) Nil) ( (ListP (car l)) (cons (RunRevL (car L)) (GoRev (cdr L))) ) ( T (cons (car L) (GoRev (cdr L))) ) ) )

(defun RunRevL (L) (setq l(GoRev L)) (setq l (reverse L)) )

(defun RevL (L) (cond ((Not (ListP L)) 'non-list) ((Null L) 'nil) (T (RunRevL L)) ) )

(RDS)

-----------------------------------------------------------------

Задание 13: Линеаризовать список произвольной структуры. Запускать (LinL ...).

(defun RunLinL (L) (cond ( (Null L) nil) ( (ListP (car L)) (append (RunLinL (car l)) (RunLinL (cdr L)))) ( T (cons (car l) (RunLinL (cdr L)))) ) )

(defun LinL (L) (cond ( (not(ListP L)) 'non-list ) ( (Null L) nil) ( T (RunLinL L)) ) )

----------------------------------------------------------------

Задание 14: Сформировать список, являющийся пересечением двух заданных линейных списков. Повторяющиеся в исзодных списках элементы должны входить в итоговый список не более одного раза. Запускать (Cross ....).

(defun RunCross (L M Temp) (cond ((Null M) Temp) ( (and (Member (car M) L) (not (Member (car M) Temp)) ) (setq Temp (cons (car M) Temp)) (setq Temp (RunCross L (cdr M) Temp)) ) (T (setq Temp (RunCross L (cdr M) Temp))) ) )

(defun Cross (L M) (cond ((Not (ListP L)) 'non-list-1 ) ((Not (ListP M)) 'non-list-2 ) ((Null L) nil) ((Null M) nil) (T (RunCross L M)) ) )

-------------------------------------------------------------------

Задание 15: Сформировать список чисел ряда Фибоначчи от первого числа до числа с заданным номерои включительно. Запускать (FiboL ....).

(defun RunFiboL (M N prev temp) (setq temp (+ (car prev) (cdr prev))) (if (< M N) (cons temp (RunFiboL (+ M 1) N (cons temp (car prev)) ) ) (list temp) ) )

(defun FiboL (N) (cond ((not (numberp n)) 'non-number!!) ((<= n 0) 'non-positive!!) ((eq n 1) '(1)) ((eq n 2) '(1 2)) (T (cons 1 (cons 2 (RunFiboL 3 N '(2 . 1) )))) ) )

(rds)

Лаб 4

Последовательные, циклические и итерационные вычисления.

Задание 16: Посчитать с заданной точностью сумму бесконечного ряда, каждый член которого задаётся формулой X^k/k!, где k изменяется от 1 до бесконечности, а значение X задано. Запускать (Sigma ...).

(DEFUN FACT (X) (COND ((= X 0) 1) (T (* X (FACT (- X 1))) ) ) ) ; (DEFUN F1 (X K) (/ 1 (FACT K))) ; (DEFUN Sigma (X EPS) (SETQ X1 (F1 X 1)) (SETQ SIGM X1) (SETQ K 1) (LOOP (SETQ K (+ K 1)) (SETQ X2 (F1 X K)) ((< (ABS (- X2 X1)) EPS) SIGM) (SETQ SIGM (+ SIGM X2)) (SETQ X1 X2) ) ) (RDS)

-----------------------------------------------------------------

Задание 17: Найти последний элемент линейного списка. Запйскать (LastEl ...).

(DEFUN LastEl (L) (COND ((NULL L) 0) (T (LOOP ((NULL (CDR L)) (CAR L)) (SETQ L (CDR L)) ) ) ) ) ; (RDS)

-----------------------------------------------------------------

Задание 18: Реализовать с помощью LOOP задание № 12 (реверс списка). Запускать (Invert2 ...).

(DEFUN INVERT1 (L) (COND ((NULL L) '()) ((ATOM (CAR L)) (APPEND (INVERT1 ( CDR L)) (LIST (CAR L))) ) ((LISTP (CAR L)) (APPEND (INVERT1 ( CDR L)) (LIST (INVERT1 (CAR L)))) ) ) ) ; (DEFUN INVERT2 (L KSP) (SETQ KSP '()) (COND ((NULL L) KSP) (T (LOOP ((NULL (CAR L)) KSP) (COND ((ATOM (CAR L)) (SETQ KSP (CONS (CAR L) KSP))) (T (SETQ KSP (CONS (INVERT2 (CAR L) '()) KSP)))) (SETQ L (CDR L)) ) ) ) )

; (RDS)

----------------------------------------------------------------

Задание 19: Удалить из числового линейного списка все элементы, не входящие в заданный интервал значений. Запускать (DNI ...).

(DEFUN INVERT1 (L) (COND ((NULL L) '()) ((ATOM (CAR L)) (APPEND (INVERT1 ( CDR L)) (LIST (CAR L))) ) ((LISTP (CAR L)) (APPEND (INVERT1 ( CDR L)) (LIST (INVERT1 (CAR L)))) ) ) ) ; ;Удаление чисел не из интервала ; (DEFUN DelnotIn (L A B KSP) (PRINT A) (PRINT B) (LOOP ((NULL (CAR L)) KSP) (IF (AND (>= (CAR L) A) (<= (CAR L) B)) (SETQ KSP (CONS (CAR L) KSP))) (SETQ L (CDR L)) ) )

(DEFUN DNI (L A B) (SETQ KSP '()) (DelNotIn L A B KSP) (INVERT1 KSP) ) ; (RDS)

----------------------------------------------------------------

Задание 20: Задан список символьных атомов. Заменить во всех атомах заданный символ на другой заданный символ, но не более, чем заданное число вхождений в каждом атоме. Запускать (EraseInSS ...).

(DEFUN ChangeInList (L A B C) (SETQ KS '()) (LOOP ((NULL L) KS) (COND ((EQ (CAR L) A) (COND ((= C 0) (SETQ KS (APPEND KS (LIST (CAR L))))) (T (SETQ C (- C 1)) (SETQ KS (APPEND KS (LIST B)))) )) (T (SETQ KS (APPEND KS (LIST (CAR L))))) ) (SETQ L (CDR L)) ) )

(DEFUN EraseInSS (L A B C) (SETQ KS1 '()) (LOOP ((NULL L) KS1) (SETQ KS1 (APPEND KS1 (LIST (PACK (CHANGEINLIST (UNPACK (CAR L)) A B C))))) (SETQ L (CDR L)) ) ) ; (RDS)

Лаб 5