各種ソート

ソートの動作を良く知らなかったので勉強。bubble-sort以外はM.Hiroi's Home Page / xyzzy Lisp Programmingから。ほぼ写経。bubble-sortは破壊的に動作し、他は新しくリストを作るので非破壊的。そのかわりコンシングが多い。

(defun bubble-sort (lst &optional (test '<))
  (let (p)
    (while (null p)
      (dotimes (i (1- (length lst)) (setq p (not p)))
        (when (funcall test (elt lst (1+ i)) (elt lst i))
          (rotatef (elt lst (1+ i)) (elt lst i))
          (setq p t)))))
  lst)

(defun quick-sort (lst &optional (test '<))
  (labels ((iter (l)
             (unless (atom l)
               (let ((p (car l)) l1 l2)
                 (dolist (a (cdr l) (nconc (iter l1) (cons p (iter l2))))
                   (if (funcall test a p) (push a l1) (push a l2)))))))
    (iter lst)))

(defun insert-sort (lst &optional (test '<))
  (labels ((iter (l r)
             (if (atom l)
                 r
               (iter (cdr l) (insert (car l) r))))
           (insert (a r)
             (cond ((atom r) (list a))
                   ((funcall test a (car r)) (cons a r))
                   (t (cons (car r) (insert a (cdr r)))))))
    (iter lst nil)))

(defun merge-sort (lst &optional (test '<))
  (labels ((iter (l n)
             (cond ((= n 1) (list (car l)))
                   ((= n 2)
                    (let ((x (car l)) (y (cadr l)))
                      (if (funcall test x y) (list x y) (list y x))))
                   (t (let ((m (truncate n 2)))
                        (merge (iter l m) (iter (nthcdr m l) (- n m)))))))
           (merge (l1 l2)
             (cond ((atom l1) l2)
                   ((atom l2) l1)
                   ((funcall test (car l1) (car l2))
                    (cons (car l1) (merge (cdr l1) l2)))
                   (t
                    (cons (car l2) (merge l1 (cdr l2)))))))
    (iter lst (length lst))))