вторник, 31 марта 2009 г.

Рекурсивные функции на Common Lisp

1. Перебор всех подписков данного списка
(defun for-all-subsets (list func)
(unless list
(funcall func nil))
(when list
(for-all-subsets
(cdr list)
(lambda (s) (funcall func (cons (car list) s))))
(for-all-subsets (cdr list) func)))
func — функция одного параметра — вызывается для каждого подсписка.

2. Перебор всех подсписков заданного размера
(defun for-all-subsets-size (list size func)
(if (zerop size)
(funcall func nil)
(when list
(for-all-subsets-size
(cdr list) (1- size)
(lambda (s) (funcall func (cons (car list) s))))
(when (< size (length list-set))
(for-all-subsets (cdr list-set) size func)))))
func — функция одного параметра — вызывается для каждого подсписка.

3. Перебор всех подсписков, полученных из данного удалением одного элемента
(defun for-all-cuts (list func)
(declare (list list) (function func))
(when list
(funcall func (car list) (cdr list)))
(when (cdr list)
(for-all-cuts (cdr list)
(lambda (elem cut)
(funcall func elem (cons (car list) cut))))))
func — функция двух параметров — вызывается для каждого элемента и соответствующего подсписка, который получен его удалением из исходного списка.

4. Перебор максимальных по включению подсписков, удовлетворяющих какому-либо условию
(defun for-all-max-subsets (set func)
(if set
(let ((saved))
(for-all-max-subsets
(cdr set)
(lambda (s)
(when (funcall func (cons (car set) s))
(push s saved))))
(for-all-max-subsets
(cdr set)
(lambda (s)
(or (position s saved :test #'equalp)
(funcall func s)))))
(progn
(funcall func nil)
nil)))
func — функция одного параметра — получает список и должна возвращать nil, если список не годится. Если для какого-то списка func вернула ненулевое значение, все подсписки этого списка не будут проверяться.

5. Перебор всех циклических перестановок данного списка
(defun for-all-cyclic-permutations (list func)
(funcall func list)
(do ((iter (cdr list) (cdr iter))
(prev list))
((not iter))
(when prev
(setf (cdr prev) nil)
(funcall func (append iter list))
(setf (cdr prev) iter))
(setf prev iter)))
func — функция одного параметра — вызывается для каждой циклической перестановки.

Примеры:
> (for-all-subsets '(a b c) #'print)

(A B C)
(A B)
(A C)
(A)
(B C)
(B)
(C)
NIL

> (for-all-subsets-size '(a b c d) 2 #'print)

(A B)
(A C)
(A D)
(B C)
(B D)
(C D)

> (for-all-cuts '(a b c d) (lambda (a b) (format t "~a ~a~%" a b)))

A (B C D)
B (A C D)
C (A B D)
D (A B C)

> (for-all-max-subsets
'(2 10 2 5 4)
(lambda (x) (if (> (apply #'+ x) 10) nil (progn (print x) t))))

(2 2 5)
(2 2 4)
(10)
(5 4)

> (for-all-cyclic-permutations '(a b c d e) #'print)

(A B C D E)
(B C D E A)
(C D E A B)
(D E A B C)
(E A B C D)

Комментариев нет: