 |
Функция member проверяет, принадлежит ли элемент списку
|
|
|
|
(defun member (x s)
(cond ((null s) nil)
((equal (first s) x) s)
(t (member x (rest s))))
)
С помощью функции trace можно устроить трассировку member.
(trace member)
(member 5 '(1 2 5 6))
; 1> MEMBER called with args:
; 5
; (1 2 5 6)
; | 2> MEMBER called with args:
; | 5
; | (2 5 6)
; | | 3> MEMBER called with args:
; | | 5
; | | (5 6)
; | | 3< MEMBER returns value:
; | | (5 6)
; | 2< MEMBER returns value:
; | (5 6)
; 1< MEMBER returns value:
; (5 6)
(5 6)
В рекурсивном определении существенен порядок следования условий. При определении порядка следования основным моментом является то, что сначала проверяются всевозможные условия окончания, а затем ситуации, требующие продолжения вычислений. При помощи условий окончания последовательно проверяются все особые случаи и программируются соответствующие результирующие выражения. На исключенные таким образом случаи можно в последующем не обращать внимания.
Предикат member в XLisp определен в другом виде, чем мы его представили. Вместо предиката сравнения equal используется предикат eql, поэтому встроенный member не может находить элементы, являющиеся списками. Но можно вместо предиката eql, являющегося умолчанием, задать при вызове с помощью ключевого параметра: test другой предикат. Например, в следующем примере для сравнения элементов используется предикат equal, который применим и к спискам:
(member ‘(c d) ‘((a b) (c d)):test #’equal) ==> ((c d))
Функция append объединяет два списка
(defun append (x y)
(if (null x) y
(cons (first x) (append (rest x) y)))
)
> (trace append)
(APPEND)
> (append '(1 2) '(3 4 5))
; 4> APPEND called with args:
; (1 2)
; (3 4 5)
; | 5> APPEND called with args:
; | (2)
; | (3 4 5)
; | | 6> APPEND called with args:
; | | NIL
; | | (3 4 5)
; | | 6< APPEND returns value:
; | | (3 4 5)
; | 5< APPEND returns value:
; | (2 3 4 5)
; 4< APPEND returns value:
; (1 2 3 4 5)
(1 2 3 4 5)
Соединение списков можно определить и по-другому:
|
|
|
(defun append1 (x y)
(if (null x) y
(append1 (rest x) (cons (first x) y)))
)
В этом случае второй параметр используется и как накапливающий результат. Отметим, что список x входит в результирующий список в обращенном виде.
Функция remove удаляет элемент из списка
; удаляет первое вхождение элемента
(defun remove (x s)
(cond ((null s) nil)
((eql x (first s)) (rest s))
(t (cons (first s) (remove x (rest s)))))
)
> (remove 2 '(1 2 3 4))
(1 3 4)
> (remove 'b '(a (b c)))
(A (B C))
> (remove '(a b) '((a b) (c d)))
((A B) (C D))
Встроенная функция remove использует предикат eql. Можно задать непосредственно предикат сравнения для функции remove при её вызове ключевым параметром:test таким же образом, как и для функции member. Приведем пример:
(remove ‘(a b) ‘((a b) (c d)):test #‘equal) ==> ((c d))
Следующий вариант функции remove удаляет все вхождения элемента.
(defun remove1 (x s)
(cond ((null s) nil)
((eql x (first s)) (remove1 x (rest s)))
(t (cons (first s) (remove1 x (rest s)))))
)
Функция reverse обращает список
(defun reverse1 (s)
(if (null s) nil
(append (reverse1 (rest s)) (list (first s))))
)
(trace reverse1)
(REVERSE1)
> (reverse1 '(a b c))
; 1> REVERSE1 called with arg:
; (A B C)
; | 2> REVERSE1 called with arg:
; | (B C)
; | | 3> REVERSE1 called with arg:
; | | (C)
; | | | 4> REVERSE1 called with arg:
; | | | NIL
; | | | 4< REVERSE1 returns value:
; | | | NIL
; | | 3< REVERSE1 returns value:
; | | (C)
; | 2< REVERSE1 returns value:
; | (C B)
; 1< REVERSE1 returns value:
; (C B A)
(C B A)
Использование накапливающего параметра дает второй вариант:
(defun reverse2 (s)
(labels
((f (x y)
(if (null x) y
(f (rest x) (cons (first x) y)))
))
(f s nil))
)
Другие формы рекурсии
Параллельное ветвление рекурсии. Рекурсию называют параллельной, если она встречается одновременно в нескольких аргументах функции. Так выглядят повторяющиеся вычисления, соответствующие следующим друг за другом (текстуально) циклам в операторном программировании.
(defun f...
... (g... (f...)... (f...)...)
...)
Сумма элементов списка на всех уровнях:
(defun sum (x)
(cond ((null x) 0)
((atom (first x)) (+ (first x) (sum (rest x))))
(t (+ (sum (first x)) (sum (rest x)))))
)
Поиск элемента на всех уровнях:
(defun member2 (x s)
(cond ((null s) nil)
|
|
|
((and (atom (first s)) (equal x (first s))))
((atom (first s)) (member2 x (rest s)))
(t (or (member2 x (first s)) (member2 x (rest s)))))
)
Взаимная рекурсия. Рекурсия является взаимной (косвенной) между двумя или более функциями, если они вызывают друг друга.
Проверка на четность и нечетность натурального числа:
(defun od (n)
(if (zerop n) nil (ev (1- n)))
)
(defun ev (n)
(if (zerop n) t (od (1- n)))
)
Рекурсия более высокого порядка, когда аргументом рекурсивного вызова является рекурсивный вызов:
(defun f...
... (f...(f...)...)
...)
Функция Аккермана
(defun akkerman (m n)
(cond ((= m 0) (1+ n))
((= n 0) (akkerman (1- m) 1))
(t (akkerman (1- m) (akkerman m (1- n)))))
)
(akkerman 3 2) ==> 29 (541 вызов)
Сортировка списка с использованием дерева. Список сортируется в два этапа: сначала он преобразуется в упорядоченное бинарное дерево, а потом дерево преобразуем в список, читая его справа налево. Пустое бинарное дерево изображается символом nil, а непустое - списком из трех элементов. Например, дерево на рис. 8 изображается списком
((((nil 1 nil) 2 (nil 3 nil)) 4 (nil 6 nil)) 7 (nil 18 nil)).
 |
Рис. 8. Бинарное дерево
; x - исходный список, результат - упорядоченный список
(defun treeSort (x)
(flatten (makeTree x)))
; создание упорядоченного дерева из списка x
(defun makeTree (x)
(if (null x) nil
(insert (first x) (makeTree (rest x)))
)
)
; вставка элемента n в упорядоченное дерево x
(defun insert (n x)
(if (null x) (list nil n nil)
(let ((left (first x))
(node (second x))
(right (third x))
)
(if (<= n node) (list (insert n left) node right)
(list left node (insert n right))
)
)))
; разглаживание дерева
(defun flatten (x)
(if (null x) nil
(append (flatten (first x))
(list (second x))
(flatten (third x))
)
)
)
|
|
|
