Programming Gems::Lisp

Материал из NNLUG Wiki.

Lisp

;; Поиск факториала числа;
;; в данном примере продемонстрирована "хвостовая рекурсия"

(defun factorial (n &optional (acc 1))
  (if (= n 0) acc
      (factorial (- n 1) (* n acc))))

;; пример использования данной функции

CL-USER> (factorial 5)
120

;; Быстрая сортировка

(defun my-qsort (list-for-sort sort-fun-less sort-fun-more)
  (if (not list-for-sort) nil
      (append (my-qsort (remove (first list-for-sort) 
                                (rest list-for-sort) 
                                :test sort-fun-less) 
                        sort-fun-less 
                        sort-fun-more)
              (list (first list-for-sort))
              (my-qsort (remove (first list-for-sort) 
                                (rest list-for-sort) 
                                :test sort-fun-more) 
                        sort-fun-less 
                        sort-fun-more))))

;; пару примеров использования

CL-USER> (my-qsort '(3 1 6 3 1 34) #'< #'>=)
(1 1 3 3 6 34)

CL-USER> (my-qsort '(#\g #\a #\f #\e #\k #\v #\s #\g #\h) #'char< #'char>=)
(#\a #\e #\f #\g #\g #\h #\k #\s #\v)

;; Работа с двоичными деревьями

;; функция вставки листа/ноды
(defun insert-leaf (tree new-node)
  (if (not tree) new-node
      (if (>= (first tree) (first new-node))
          (list (first tree) 
                (insert-leaf (second tree) new-node) 
                (third tree))
          (list (first tree) 
                (second tree) 
                (insert-leaf (third tree) new-node)))))

;; функция создающая новый лист/ноду
(defun make-node (element)
  (list element nil nil))

;; вспомогательная функция, используется при удалении листа/ноды
(defun move-it (from to)
  (if (second to)
      (list (first to)
            (move-it from (second to))
            (third to))
      (list (first to)
            from
            (third to))))

;; ещё одна вспомогательная функция для удаления листа/ноды
(defun remove-it (node)
  (cond ((and (second node) (third node)) (move-it (second node) (third node)))
        ((second node) (second node))
        ((third node) (third node))
        (t nil)))

;; сама функция удаления листа/ноды
(defun remove-node (tree key)
  (if (not tree) 
      nil
      (cond ((< key (first tree)) (list (first tree)
                                        (remove-node (second tree) key)
                                        (third tree)))
            ((> key (first tree)) (list (first tree)
                                        (second tree)
                                        (remove-node (third tree) key)))
            ((= key (first tree)) (remove-it tree)))))

;; функция которая из списка элементов строит двочное дерево
(defun make-tree (elements)
  (reduce #'insert-leaf 
          (map 'list #'make-node elements)))

;; пару примеров использования

CL-USER> (make-tree '(5 3 6 7))
(5 (3 NIL NIL) (6 NIL (7 NIL NIL)))
 
CL-USER> (remove-node (make-tree '(5 3 6 7)) 6)
(5 (3 NIL NIL) (7 NIL NIL))

CL-USER> (remove-node (make-tree '(5 3 6 7)) 5)
(6 (3 NIL NIL) (7 NIL NIL))