На этом шаге мы приведем задачи, иллюстрирующие императивный стиль программированияя на языке LISP.
; ----------------------------------------------------- ; ; Найдется ли такое натуральное число I, не превосходя- ; ; щее заданного числа N, что число 2*I+15 будет ; ; составным ; ; ----------------------------------------------------- ; (DEFUN ZAD19 (LAMBDA (N) (SETQ I 1) (LOOP ( (> I N) PRIN1 "Нет такого числа!" ) ( (SIMPLE (+ (* 2 I) 15)) I ) (SETQ I (+ I 1)) ) )) ; --------------------- ; (DEFUN SIMPLE (LAMBDA (N) (SETQ FLAG 1) (COND ( (AND (EQ (MOD N 2) 0) (NOT (EQ N 2))) NIL ) ( T ( (SETQ I 3) (LOOP ( (< (CAR (DIVIDE N 2)) I) ) ( (EQ (CDR (DIVIDE N I)) 0) (SETQ FLAG 0) ) ( SETQ I (+ I 2) ) ) (COND ( (EQ FLAG 0) NIL ) ( T T ))) ) ) ))
; ---------------------------------------------- ; ; Определить, какой цифрой оканчивается число 7, ; ; возведенное в степень 77 ; ; ---------------------------------------------- ; (DEFUN CON (LAMBDA (NUM1 NUM2) (CAR (REVERSE (UNPACK (POWER NUM1 NUM2)))) )) ; ---------------------------- ; (DEFUN POWER (LAMBDA (NUM1 NUM2) ( (AND (ZEROP NUM1) (MINUSP NUM2)) (PRINT "Результат не существует!") ) (SETQ NUM3 1) (LOOP (SETQ NUM2 (DIVIDE NUM2 2)) ( ( (EQ (CDR NUM2) 1) (SETQ NUM3 (* NUM1 NUM3)) ) ) ( SETQ NUM2 (CAR NUM2) ) ( (ZEROP NUM2) NUM3 ) ( SETQ NUM1 (* NUM1 NUM1)) ) ))
; ------------------------------------------------- ; ; Дописать к 523... три цифры так, чтобы полученное ; ; шестизначное число делилось на 7, 8 и на 9 ; ; ------------------------------------------------- ; (DEFUN DEL (LAMBDA () (SETQ N 523000) (LOOP ((EQ N 999999) 0) ((AND (ZEROP (CDR (DIVIDE N 7))) (ZEROP (CDR (DIVIDE N 8))) (ZEROP (CDR (DIVIDE N 9)))) N) (SETQ N (+ N 1)) ) ))
; ------------------------------------------------- ; ; Установить, является ли число 210-p простым, если ; ; число p простое и 100<p<200 ; ; ------------------------------------------------- ; (DEFUN PROST (LAMBDA (P) (COND ( (AND (SIMPLE P) (AND (> P 100) (< P 200)) ) (SIMPLE (- 210 P)) ) ) )) ; --------------------- ; (DEFUN SIMPLE (LAMBDA (N) ; Предикат, позволяющий установить, является ли ; ; заданное целое число N простым ; (SETQ FLAG 1) (COND ( (AND (EQ (MOD N 2) 0) (NOT (EQ N 2))) PRIN1 "Не простое!" ) ( T ( (SETQ I 3) (LOOP ( (< (CAR (DIVIDE N 2)) I) ) ( (EQ (CDR (DIVIDE N I)) 0) (SETQ FLAG 0) ) ( SETQ I (+ I 2) ) ) (COND ( (EQ FLAG 0) NIL ) ( T T ))) ) ) ))
; ------------------------------------------------ ; ; При каком наименьшем натуральном М число М^3+3^M ; ; делится на 7 ; ; ------------------------------------------------ ; (DEFUN FAY (LAMBDA (K) (SETQ M 1) ( LOOP ( (> M K) 0 ) ( SETQ L (STEPEN 3 M) ) ( SETQ N (STEPEN M 3) ) ( SETQ T (+ L N) ) ( (ZEROP (CDR (DIVIDE T 7))) M ) ( SETQ M (+ M 1) ) ) )) ; ----------------------- ; (DEFUN STEPEN (LAMBDA (X A) (COND ( (ZEROP A) 1 ) ( (ZEROP (- A 1)) X ) ( T (* X (STEPEN X (- A 1))) ) ) ))
; --------------------------------------- ; ; Найти целые числа от 1 до N, которые ; ; делятся и на 3, и на 5, и на 7 ; ; --------------------------------------- ; (DEFUN DA1 (LAMBDA (N) (SETQ L 0) (SETQ I 1) ( LOOP ( (> I N) ((PRINT "Всего чисел") L) ) (COND ( (AND (ZEROP (CDR (DIVIDE I 3))) (ZEROP (CDR (DIVIDE I 5))) (ZEROP (CDR (DIVIDE I 7)))) ( (SETQ L (+ L 1)) (PRINT I)) )) (SETQ I (+ I 1)) ) ))
; -------------------------------------------- ; ; Существуют ли 4 последовательных натуральных ; ; числа, сумма квадратов которых равна сумме ; ; квадратов трех следующих натуральных чисел? ; ; -------------------------------------------- ; (DEFUN SM (LAMBDA NIL (SETQ I 22) (LOOP ( (EQ I 1000) ) (SETQ A1 (* I I )) (SETQ A2 (* (+ I 1) (+ I 1))) (SETQ A3 (* (+ I 2) (+ I 2))) (SETQ A4 (* (+ I 3) (+ I 3))) ; ----------------------------------- ; (SETQ A5 (* (+ I 4) (+ I 4))) (SETQ A6 (* (+ I 5) (+ I 5))) (SETQ A7 (* (+ I 6) (+ I 6))) ; ------------------------------------- ; (SETQ B1 (+ A1 (+ A2 (+ A3 A4)))) (SETQ B2 (+ A5 (+ A6 A7))) ( (EQ B1 B2) (PRINT I) ) (SETQ I (+ I 1)) ) ))
; -------------------------------------------------- ; ; По данному целому числу К>7 найти пару целых неот- ; ; рицательных чисел A и B таких, что K = 3A + 5B ; ; -------------------------------------------------- ; (DEFUN PARA (LAMBDA (K) (SETQ N 100) (PRIN1 "Значение A и B ...: ") (SETQ A 0) ( LOOP ( (> A N) ) (SETQ B 0) (LOOP ( (> B N) ) ( (EQ K (+ (* A 3) (* B 5))) ((PRIN1 A) (PRIN1 " ") (PRINT B)) ) (SETQ B (+ B 1)) ) (SETQ A (+ A 1)) ) ))
; ------------------------------------------ ; ; Определить функцию FIB(N), вычисляющую N-й ; ; элемент последовательности Фибоначчи ; ; ------------------------------------------ ; ; Императивный стиль программирования ; ; ------------------------------------------ ; (DEFUN FIB1 (LAMBDA (K) (COND ( (EQ K 1) 1 ) ( (EQ K 2) 1 ) ( T ( (SETQ I 3) (SETQ F1 1) (SETQ F2 1) (SETQ F3 2) ( LOOP ( (> I K) F3) (SETQ F3 (+ F1 F2)) (SETQ F1 F2) (SETQ F2 F3) (SETQ I (+ I 1)))) ) ) )) ; ------------------------------------- ; ; Функциональный стиль программирования ; ; ------------------------------------- ; (DEFUN FIB (LAMBDA (K) (COND ( (ZEROP K) 0) ( (EQ K 1) 1) ( T (+ (FIB (- K 1)) (FIB (- K 2))) ) ) ))
; ------------------------------------------------- ; ; Если введенный номер числа Фибоначчи K и само ; ; это число кратны пяти, то вернуть список из числа ; ; Фибоначчи и его номера, в противном случае - NIL ; ; ------------------------------------------------- ; (DEFUN FIBFIFE (LAMBDA (K) (COND ( (AND (ZEROP (CDR (DIVIDE K 5))) (ZEROP (CDR (DIVIDE (FIB K) 5))) ) (LIST (FIB K) K) ) ( T NIL ) ) )) ; ------------------ ; (DEFUN FIB (LAMBDA (K) (COND ( (EQ K 1) 1 ) ( (EQ K 2) 1 ) ( T ( (SETQ I 3) (SETQ F1 1) (SETQ F2 1) (SETQ F3 2) ( LOOP ( (> I K) F3 ) (SETQ F3 (+ F1 F2)) (SETQ F1 F2) (SETQ F2 F3) (SETQ I (+ I 1)))) ) ) ))
; ---------------------------------------------------- ; ; Перевести число N в систему счисления с основанием F ; ; ---------------------------------------------------- ; (DEFUN EEE (LAMBDA (N F) (SETQ LST NIL) (SETQ REM (CDR (DIVIDE N F))) (SETQ I (CAR (DIVIDE N F))) (SETQ LST (CONS REM LST)) ( LOOP (SETQ N I) (SETQ REM (CDR (DIVIDE N F))) (SETQ I (CAR (DIVIDE N F))) (SETQ LST (CONS REM LST)) ( (< I F) ) ) (PRINT (SETQ LST (CONS I LST))) ))
; ---------------------------------------------------- ; ; Напишите наименьшее трехзначное число, кратное 3, ; ; так, чтобы первая цифра его была 6, и все цифры были ; ; бы различны ; ; ---------------------------------------------------- ; (DEFUN CHCH (LAMBDA NIL (SETQ I 0) (LOOP ( (> I 9) ) (SETQ J 0) ( LOOP ( (> J 9) ) (COND ( (AND (ZEROP (MOD (+ (* 10 I) (+ J 600)) 3)) (NOT (EQ I J)) (NOT (EQ I 6)) (NOT (EQ J 6))) (PRIN1 6) (PRIN1 I) (PRIN1 J) (PRIN1 " ")) ) (SETQ J (+ J 1)) ) (SETQ I (+ I 1)) ) ))
; ----------------------------------------------- ; ; Натуральные числа m и n взаимно просты и n < m. ; ; Какое число больше: ; ; (1*m/n) + (2*m/n) +...+ (n*m/n) ; ; или ; ; (1*n/m) + (2*n/m) +...+ (m*n/m)? ; ; ----------------------------------------------- ; (DEFUN SUMMA (LAMBDA (N М) (SETQ S2 0) (SETQ I 1) (PRIN1 "Введите M... ") (SETQ M (READ)) (PRIN1 "Введите N... ") (SETQ N (READ)) (LOOP ( (> I M) S2 ) (SETQ S2 (+ S2 (CAR (DIVIDE (* I N) M)))) (SETQ I (+ I 1)) ) (SETQ S1 0) (SETQ I 1) (LOOP ( (> I N ) S1 ) (SETQ S1 (+ S1 (CAR (DIVIDE (* I M) N)))) (SETQ I (+ I 1)) ) (COND ( (> S1 S2) (PRINT "Первое число больше") ) ( T (PRINT "Второе число больше") ) ) (PRIN1 "Разность... ") (- S1 S2) ))
; --------------------------------------- ; ; Найдите трехзначные числа, равные сумме ; ; факториалов своих цифр ; ; --------------------------------------- ; (DEFUN MAIN (LAMBDA () (SETQ N 100) (LOOP ( (EQ N 999) 999 ) ( (EQ N (+ (FACT (CAR (STRING-NUM (UNPACK N)))) (+ (FACT (CADR (STRING-NUM (UNPACK N)))) (FACT (CADDR (STRING-NUM (UNPACK N)))) ) ) ) ( (PRINT "Число... ") N ) ) ( SETQ N (+ N 1) ) ) )) ; ------------------- ; (DEFUN FACT (LAMBDA (X) (COND ( (ZEROP X) 1 ) ( T (* X (FACT (- X 1))) ) ) )) ; ------------------------- ; (DEFUN STRING-NUM (LAMBDA (X) ; Перевод списка цифр в список, содержащий ; ; соответствующие однозначные числа ; (COND ( (EQ (LENGTH X) 1) (CONS (POSITION (CAR X) (UNPACK 123456789)) 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 ) ) ))
; ----------------------------------------------------- ; ; Написать программу, в результате выполнения которой ; ; выясняется, входит ли цифра 2 в запись данного целого ; ; числа n ; ;------------------------------------------------------ ; (DEFUN MAIN (LAMBDA () (SETQ LST (STRING-NUM (UNPACK (READ)))) (SETQ FLAG 0) (LOOP ( (NULL LST) FLAG ) ( (EQ (CAR LST) 2) (SETQ FLAG 1) ) ( SETQ LST (CDR LST) ) ) (COND ( (EQ FLAG 1) (PRINT "Есть в записи число 2") ) ( T (PRINT "Нет в записи числа 2") ) ) )) ; ------------------------- ; (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 ) ) ))
Мы закончили изложение основ языка программирования LISP.