シェルソート習作

(setq h 3)

(defun make-new-list (&optional (list) (num) (n 0) (t-list nil))
  (cond ((not (cdr list))
	 (if (= num n)
	     (append t-list (list (car list)))
	     t-list))
	((= num n)
	 (make-new-list (cdr list) (+ num h) (1+ n) (append t-list (list (car list)))))
	(t
	 (make-new-list (cdr list) num (1+ n) t-list))))

(defun replace-list (&optional (list) (num) (t-list) (n 0))
  (if (= num n)
    (progn
      (setf (car list) (car t-list))
      (if (cdr t-list)
	(setf (cdr list) (replace-list (cdr list) (+ num h) (cdr t-list) (1+ n)))))
    (setf (cdr list) (replace-list (cdr list) num t-list (1+ n))))
  list)

(defun do-simple-insert (list num)
  (if (not list)
      (setf list (list num))
      (if (< (car list) num)
	  (setf (cdr list) (do-simple-insert (cdr list) num))
	  (setf list (cons num list))))
  list)

(defun simple-insert-sort (list)
  (let ((ret-list))
    (dolist (x list ret-list)
      (setf ret-list (do-simple-insert ret-list x)))))

(defun shell-sort (list)
  (if (not (= h 1))
      (progn
	(dotimes (x h ret-list)
	  (setf list (replace-list list x (simple-insert-sort (make-new-list list x)))))
	(setf h (round (/ h 2)))
	(shell-sort list))
      (simple-insert-sort list)))

; 結果
; * (shell-sort '(3 1 5 2 6 4))
;
; (1 2 3 4 5 6)
; * 

　微妙に寝不足なので、これで手一杯。大枠は間違っていなくとも、随分回り道をしてる予感がぷんぷんする。
　備忘録として書いておくと、make-new-listは、num+(hの倍数)の位置の要素を取り出して、新たなリストを作成。replace-listは、num+(hの倍数)の位置の要素を、t-listのcarにそれぞれ置き換える。この動作は、t-listがなくなるまで続く。あとは単純挿入ソートと同じかな。