книги / Функциональное программирование

(if (eql name2 (car x2)) (set 'xx2 (CADR x2)) (if (eql name2 (car x3)) (set 'xx2 (CADR x3)) (set 'xx2 (CADR x4))

)))

(if (= xx1 xx2) (print 'ровесники) (if (> xx1 xx2)

(print (list name1 'младше name2)) (print (list name1 'старше name2))

)))

(defun sr_ball (name1 name2) (if (eql name1 (car x1)) (set 'xx1 (CADDR x1)) (if (eql name1 (car x2))

(set 'xx1 (CADDR x2)) (if (eql name1 (car x3)) (set 'xx1 (CADDR x3)) (set 'xx1 (CADDR x4))

)))

(if (eql name2 (car x1)) (set 'xx2 (CADDR x1)) (if (eql name2 (car x2)) (set 'xx2 (CADDR x2)) (if (eql name2 (car x3))

(set 'xx2 (CADDR x3)) (set 'xx2 (CADDR x4))

)))

(if (= xx1 xx2)

(print (list 'у name1 name2 'баллы_одинаковые)) (if (< xx1 xx2)

(print (list 'у name1 'средний_балл_меньше_чем_у name2)) (print (list 'у name1 'средний_балл_больше_чем_у name2))

141

)))

(defun rodstv (name1 name2)

(when (eql name1 (car x1)) (set 'xx1 (CADDDR x1)) (set 'xx2 (car (CDDDDR x1))))

(when (eql name1 (car x2)) (set 'xx1 (CADDDR x2)) (set 'xx2 (car (CDDDDR x2))))

(when (eql name1 (car x3)) (set 'xx1 (CADDDR x3)) (set 'xx2 (car (CDDDDR x3))))

(when (eql name1 (car x4)) (set 'xx1 (CADDDR x4)) (set 'xx2 (car (CDDDDR x4))))

(when (eql name2 (car x1)) (set 'xx3 (CADDDR x1)) (set 'xx4 (car (CDDDDR x1))))

(when (eql name2 (car x2)) (set 'xx3 (CADDDR x2)) (set 'xx4 (car (CDDDDR x2))))

(when (eql name2 (car x3)) (set 'xx3 (CADDDR x3)) (set 'xx4 (car (CDDDDR x3))))

(when (eql name2 (car x4)) (set 'xx3 (CADDDR x4)) (set 'xx4 (car (CDDDDR x4))))

(when (and (EQL xx1 xx3) (EQL xx2 xx4)) (print (list name1 name2 'родственники)))

(unless (and (EQL xx1 xx3) (EQL xx2 xx4))

(print (list name1 name2 ' = не_родственники)))

)

Тест:

>(rovest 'IVANOV 'IVANIN) (IVANOV СТАРШЕ IVANIN) (IVANOV СТАРШЕ IVANIN) >(sr_ball 'IVANOV 'IVANIN)

(У IVANOV СРЕДНИЙ_БАЛЛ_БОЛЬШЕ_ЧЕМ_У IVANIN) (У IVANOV СРЕДНИЙ_БАЛЛ_БОЛЬШЕ_ЧЕМ_У IVANIN) >(rodstv 'IVANOV 'IVANIN)

(IVANOV IVANIN РОДСТВЕННИКИ) NIL

142

Упражнение для самоконтроля 1 к теме 2

Задача 2.1

Нарисуйте следующие списки при помощи списочных ячеек и стрелок:

а) (а)

б) (а (b (с) d)) в) (nil (b . с) . d)

Задача 2.2

Необходимо найти расстояние между точками (городами) при помощи уравнения с (x22 x12) (y22 y12) , где координа-

ты городов (x, y) берутся из свойства указанных городов, при помощи функции get.

143

Функция нахождения расстояния между городами записывается следующим образом:

(defun rast (а b)

(sqrt (+ (expt (– (get a ‘x) (get b ‘x)) 2) (expt (– (get а ‘у) (get b ‘у)) 2))))

или

(defun rast (а b)

(sqrt (+ (expt (– (get a ‘x) (get b ‘x)) ‘2) (expt (– (get а ‘у) (get b ‘у)) ‘2))))

Задача 2.3

(defun родители (х)

(list (get x 'мать) (get x 'отец)))

(defun сестры-братья (х у)

(or (eq (get x 'мать) (get у 'мать)) (eq (get x 'отец) (get у 'отец))))

Задача 2.4

(defun remprops (x) (cond ((symbol-plist x)

(remprop x (car (symbol-plist x))) (remprops x)) (t 'готово)))

Упражнение для самоконтроля 2 к теме 2

Задача 2.6

(defun factorial (n) (cond

((=n0)1) ;факториал0!равен1

(t(*(factorial(–n1))n))));факториалn!равен(n–1)!*n >(trace factorial)

(FACTORIAL) >(factorial 3)

Entering: FACTORIAL, Argument list: (3) Entering: FACTORIAL, Argument list: (2)

144

Entering: FACTORIAL, Argument list: (1) Entering: FACTORIAL, Argument list: (0) Exiting: FACTORIAL, Value: 1

Exiting: FACTORIAL, Value: 1 Exiting: FACTORIAL, Value: 2

Exiting: FACTORIAL, Value: 6 6

Задача 2.7

(defun power (x n) (cond

((=n0)1);x0 =1(любоечисловнулевойстепениравно1) (t (* (power x (– n 1)) x)))); xn = x (n – 1) *n (значение x в

степени n вычисляется возведением x в степень n – 1 и умножением результата на n)

>(trace power) (POWER) >(power 2 3)

Entering: POWER, Argument list: (2 3) Entering: POWER, Argument list: (2 2) Entering: POWER, Argument list: (2 1)

Entering: POWER, Argument list: (2 0) Exiting: POWER, Value: 1

Exiting: POWER, Value: 2

Exiting: POWER, Value: 4

Exiting: POWER, Value: 8 8

Задача 2.8

(defun member (el list) (cond

;список просмотрен до конца, элемент не найден

((null list) nil)

;очередная голова списка равна искомому элементу, элемент найден

((equal el (car list)) t)

145

; если элемент не найден, продолжить его поиск в хвосте списка

(t (member el (cdr list))))) >(trace member)

(MEMBER) >(member 2 '(1 2 3))

Entering: MEMBER, Argument list: (2 (1 2 3)) Entering: MEMBER, Argument list: (2 (2 3)) Exiting: MEMBER, Value: T

Exiting: MEMBER, Value: T T

Задача 2.9

(defun full_copy_list (list) (cond

;копией пустого списка является пустой список

((null list) nil)

;копией элемента-атома является элемент-атом

((atom list) list)

;копией непустого списка является список, полученный из копии головы

;и копии хвоста исходного списка

(t (cons (full_copy_list (car list)) (full_copy_list (cdr list)))))) >(full_copy_list '(((1) 2) 3))

(((1) 2) 3) >(full_copy_list ()) NIL

Задача 2.10

(defun reverse (list) (cond

((atom list) list)

(t (rearrange list nil))))) (defun rearrange (list result)

146

(cond

((null list) result)

(t (rearrange (cdr list) (cons (reverse (car list)) result))))) >(reverse '(((1 2 3) 4 5) 6 7))

(7 6 (5 4 (3 2 1)))

Задача 2.11

(defun ackerman (cond

((= n 0) (+ n 1))

((= m 0) (ackerman (– m 1) 1))

(t (ackerman (– m 1) (ackerman m (– n 1)))))) >(ackerman 2 2)

7

>(ackerman 2 3) 9

>(ackerman 3 2) 29

Задача 2.12

(defun funcall1 (fn &rest args) (apply fn args))

Задача 2.13

(defmacro call-args (&rest args) `(quote, args))

>(call-args при вызове функции все равно что писать. Все равно выведет)

(ПРИ ВЫЗОВЕ ФУНКЦИИ ВСЕ РАВНО ЧТО ПИСАТЬ. ВСЕ РАВНО ВЫВЕДЕТ)

147

Упражнение для самоконтроля 1 к теме 3

Задача 3.1

(defun kol (l) (cond ((null l) 0)

((atom (car l))

(+ 1 (kol (cdr l)))) (t (+ (kol (car l))

(kol (cdr l))))))

Задача 3.2

(defun чередуй (х у) (cond ((null x) y)

(t (cons (car x) (чередуй у (cdr x))))))

«Изюминка» решения данной задачи заключается в том, что списки в функции «чередуй» меняются местами.

148

ГЛОССАРИЙ

A

and – логическая функция

append – функция, которая объединяет два и более списков в один

ARPANET – сеть передачи данных

atom – проверяет, является ли объект атомом

С

car – отделяет голову списка (первый элемент списка) case – выбирающее предложение

cdr – отделяет хвост списка (все элементы, кроме первого) cons – соединяет элемент и список в новый список, где

присоединенный элемент становится головой нового списка

D

defun – дает имя описанию функции

defvar – функция объявления динамической или специальной переменной

div – целочисленное деление

do – предложение, аналог оператора цикла

E

eq – предикат, который сравнивает два выражения и возвращает Т, если они одинаковые, и NIL в обратном случае

equal – проверяет объекты на равенство

exit – выполняет немедленный выход из программы

G

go – функция передачи управления

149

H

Haskell – язык функционального программирования Hope – язык функционального программирования

I if – условное предложение

L

LAMBDA – в «Лиспе» определение лямбда-выражения last – функция, которая удаляет из списка все элементы

кроме последнего

length – функция, которая возвращает в качестве значения длину списка, т.е. число элементов на верхнем уровне

let – предложение, которое служит для одновременного присваивания значений нескольким переменным

Lisp – язык функционального программирования (от LIStProcessing)

list – функция, которая создает список из S-выражений loop – функция цикла

M

MIRANDA– язык функционального программирования ML – язык функционального программирования

mod – остаток от целочисленного деления

N

nil – специальная константа «Лиспа», обозначающая false (ложь) или пустой список

not – логическая функция

nth – функция, которая извлекает n-й элемент из списка

O

Objective Caml – язык функционального программирования or – логическая функция ИЛИ

150