;;; shell-sort.lisp
;;; Чисто функциональная реализация сортировки Шелла для списков
;;; (без SET/SETQ/SETF и без индексации), последовательность шагов Р. Седжвика.
 
(defun list-length (l)
  (if (null l) 0 (1+ (list-length (cdr l)))))
 
;; Формула шагов по Р. Седжвику:
;; для k чётного:  g(k) = 1 + 9*2^k - 9*2^(k/2)
;; для k нечётного: g(k) = 1 + 8*2^k - 6*2^((k+1)/2)
(defun sedgewick-gap (k)
  (if (evenp k)
      (+ 1 (- (* 9 (expt 2 k)) (* 9 (expt 2 (floor k 2))))) 
      (+ 1 (- (* 8 (expt 2 k)) (* 6 (expt 2 (floor (+ k 1) 2)))))))
 
;; Генерация всех шагов < n (в порядке убывания — большие шаги сначала)
(defun sedgewick-gaps (n)
  (labels ((gen (k acc)
             (let ((g (sedgewick-gap k)))
               (if (>= g n) acc (gen (1+ k) (cons g acc))))))
    (gen 0 nil)))
 
;; Создать список из k пустых списков: (nil nil ...)
(defun make-nils (k)
  (if (zerop k) nil (cons nil (make-nils (1- k)))))
 
;; Добавить элемент x в pos-ю подпоследовательность (без мутаций)
(defun add-to-pos (acc pos x)
  (if (zerop pos)
      (cons (append (car acc) (list x)) (cdr acc))
      (cons (car acc) (add-to-pos (cdr acc) (1- pos) x))))
 
;; Разбить список lst на "gap" подпоследовательностей:
;; i-я подпоследовательность содержит элементы на позициях i, i+gap, i+2*gap, ...
(defun split-by-gap (lst gap)
  (labels ((split-rec (lst pos acc)
             (if (null lst)
                 acc
                 (split-rec (cdr lst)
                            (if (= pos (1- gap)) 0 (1+ pos))
                            (add-to-pos acc pos (car lst)))))) 
    (split-rec lst 0 (make-nils gap))))
 
;; Вставка элемента в отсортированный список (возврат нового списка)
(defun insert-into-sorted (x sorted)
  (if (or (null sorted) (< x (car sorted)))
      (cons x sorted)
      (cons (car sorted) (insert-into-sorted x (cdr sorted)))))
 
;; Рекурсивная сортировка вставками
(defun insertion-sort (lst)
  (if (null lst) nil
      (insert-into-sorted (car lst) (insertion-sort (cdr lst)))))
 
;; Рекурсивный map
(defun map-rec (f lst)
  (if (null lst) nil (cons (funcall f (car lst)) (map-rec f (cdr lst)))))
 
(defun all-empty-p (slist)
  (if (null slist) t
      (if (null (car slist)) (all-empty-p (cdr slist)) nil)))
 
(defun take-heads-once (slist)
  (if (null slist) nil
      (let ((h (car slist)))
        (if (null h) (take-heads-once (cdr slist))
            (cons (car h) (take-heads-once (cdr slist)))))))
 
(defun tails (slist)
  (if (null slist) nil
      (let ((h (car slist)))
        (cons (if (null h) nil (cdr h)) (tails (cdr slist))))))
 
(defun interleave (slist)
  (labels ((inter-rec (slist)
             (if (all-empty-p slist) nil
                 (append (take-heads-once slist)
                         (inter-rec (tails slist)))))) 
    (inter-rec slist)))
 
(defun shell-sort-by-gaps (lst gaps)
  (if (null gaps) lst
      (let ((g (car gaps)))
        (shell-sort-by-gaps
         (interleave (map-rec #'insertion-sort (split-by-gap lst g)))
         (cdr gaps)))))
 
(defun shell-sort (lst)
  "Чисто функциональная сортировка Шелла для списка LIST (по возрастанию)."
  (let ((n (list-length lst)))
    (shell-sort-by-gaps lst (sedgewick-gaps n))))
 
;;; -----------------------------
;;; Примеры использования
;;; -----------------------------
(defun run-shell-sort-examples ()
  "Показать примеры работы shell-sort. Возвращает NIL после вывода."
  (format t "~%Shell-sort examples:~%~%")
  (format t "1) ~S -> ~S~%" '(3 1 4 1 5 9 2 6 5) (shell-sort '(3 1 4 1 5 9 2 6 5)))
  (format t "2) ~S -> ~S~%" '(10 9 8 7 6 5 4 3 2 1) (shell-sort '(10 9 8 7 6 5 4 3 2 1)))
  (format t "3) ~S -> ~S~%" '() (shell-sort '()))
  (format t "4) ~S -> ~S~%" '(42) (shell-sort '(42)))
  (format t "5) ~S -> ~S~%" '(5 3 5 3 2 1 4) (shell-sort '(5 3 5 3 2 1 4)))
  nil)
 

Ozs7IHNoZWxsLXNvcnQubGlzcAo7Ozsg0KfQuNGB0YLQviDRhNGD0L3QutGG0LjQvtC90LDQu9GM0L3QsNGPINGA0LXQsNC70LjQt9Cw0YbQuNGPINGB0L7RgNGC0LjRgNC+0LLQutC4INCo0LXQu9C70LAg0LTQu9GPINGB0L/QuNGB0LrQvtCyCjs7OyAo0LHQtdC3IFNFVC9TRVRRL1NFVEYg0Lgg0LHQtdC3INC40L3QtNC10LrRgdCw0YbQuNC4KSwg0L/QvtGB0LvQtdC00L7QstCw0YLQtdC70YzQvdC+0YHRgtGMINGI0LDQs9C+0LIg0KAuINCh0LXQtNC20LLQuNC60LAuCgooZGVmdW4gbGlzdC1sZW5ndGggKGwpCiAgKGlmIChudWxsIGwpIDAgKDErIChsaXN0LWxlbmd0aCAoY2RyIGwpKSkpKQoKOzsg0KTQvtGA0LzRg9C70LAg0YjQsNCz0L7QsiDQv9C+INCgLiDQodC10LTQttCy0LjQutGDOgo7OyDQtNC70Y8gayDRh9GR0YLQvdC+0LPQvjogIGcoaykgPSAxICsgOSoyXmsgLSA5KjJeKGsvMikKOzsg0LTQu9GPIGsg0L3QtdGH0ZHRgtC90L7Qs9C+OiBnKGspID0gMSArIDgqMl5rIC0gNioyXigoaysxKS8yKQooZGVmdW4gc2VkZ2V3aWNrLWdhcCAoaykKICAoaWYgKGV2ZW5wIGspCiAgICAgICgrIDEgKC0gKCogOSAoZXhwdCAyIGspKSAoKiA5IChleHB0IDIgKGZsb29yIGsgMikpKSkpIAogICAgICAoKyAxICgtICgqIDggKGV4cHQgMiBrKSkgKCogNiAoZXhwdCAyIChmbG9vciAoKyBrIDEpIDIpKSkpKSkpCgo7OyDQk9C10L3QtdGA0LDRhtC40Y8g0LLRgdC10YUg0YjQsNCz0L7QsiA8IG4gKNCyINC/0L7RgNGP0LTQutC1INGD0LHRi9Cy0LDQvdC40Y8g4oCUINCx0L7Qu9GM0YjQuNC1INGI0LDQs9C4INGB0L3QsNGH0LDQu9CwKQooZGVmdW4gc2VkZ2V3aWNrLWdhcHMgKG4pCiAgKGxhYmVscyAoKGdlbiAoayBhY2MpCiAgICAgICAgICAgICAobGV0ICgoZyAoc2VkZ2V3aWNrLWdhcCBrKSkpCiAgICAgICAgICAgICAgIChpZiAoPj0gZyBuKSBhY2MgKGdlbiAoMSsgaykgKGNvbnMgZyBhY2MpKSkpKSkKICAgIChnZW4gMCBuaWwpKSkKCjs7INCh0L7Qt9C00LDRgtGMINGB0L/QuNGB0L7QuiDQuNC3IGsg0L/Rg9GB0YLRi9GFINGB0L/QuNGB0LrQvtCyOiAobmlsIG5pbCAuLi4pCihkZWZ1biBtYWtlLW5pbHMgKGspCiAgKGlmICh6ZXJvcCBrKSBuaWwgKGNvbnMgbmlsIChtYWtlLW5pbHMgKDEtIGspKSkpKQoKOzsg0JTQvtCx0LDQstC40YLRjCDRjdC70LXQvNC10L3RgiB4INCyIHBvcy3RjiDQv9C+0LTQv9C+0YHQu9C10LTQvtCy0LDRgtC10LvRjNC90L7RgdGC0YwgKNCx0LXQtyDQvNGD0YLQsNGG0LjQuSkKKGRlZnVuIGFkZC10by1wb3MgKGFjYyBwb3MgeCkKICAoaWYgKHplcm9wIHBvcykKICAgICAgKGNvbnMgKGFwcGVuZCAoY2FyIGFjYykgKGxpc3QgeCkpIChjZHIgYWNjKSkKICAgICAgKGNvbnMgKGNhciBhY2MpIChhZGQtdG8tcG9zIChjZHIgYWNjKSAoMS0gcG9zKSB4KSkpKQoKOzsg0KDQsNC30LHQuNGC0Ywg0YHQv9C40YHQvtC6IGxzdCDQvdCwICJnYXAiINC/0L7QtNC/0L7RgdC70LXQtNC+0LLQsNGC0LXQu9GM0L3QvtGB0YLQtdC5Ogo7OyBpLdGPINC/0L7QtNC/0L7RgdC70LXQtNC+0LLQsNGC0LXQu9GM0L3QvtGB0YLRjCDRgdC+0LTQtdGA0LbQuNGCINGN0LvQtdC80LXQvdGC0Ysg0L3QsCDQv9C+0LfQuNGG0LjRj9GFIGksIGkrZ2FwLCBpKzIqZ2FwLCAuLi4KKGRlZnVuIHNwbGl0LWJ5LWdhcCAobHN0IGdhcCkKICAobGFiZWxzICgoc3BsaXQtcmVjIChsc3QgcG9zIGFjYykKICAgICAgICAgICAgIChpZiAobnVsbCBsc3QpCiAgICAgICAgICAgICAgICAgYWNjCiAgICAgICAgICAgICAgICAgKHNwbGl0LXJlYyAoY2RyIGxzdCkKICAgICAgICAgICAgICAgICAgICAgICAgICAgIChpZiAoPSBwb3MgKDEtIGdhcCkpIDAgKDErIHBvcykpCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAoYWRkLXRvLXBvcyBhY2MgcG9zIChjYXIgbHN0KSkpKSkpIAogICAgKHNwbGl0LXJlYyBsc3QgMCAobWFrZS1uaWxzIGdhcCkpKSkKCjs7INCS0YHRgtCw0LLQutCwINGN0LvQtdC80LXQvdGC0LAg0LIg0L7RgtGB0L7RgNGC0LjRgNC+0LLQsNC90L3Ri9C5INGB0L/QuNGB0L7QuiAo0LLQvtC30LLRgNCw0YIg0L3QvtCy0L7Qs9C+INGB0L/QuNGB0LrQsCkKKGRlZnVuIGluc2VydC1pbnRvLXNvcnRlZCAoeCBzb3J0ZWQpCiAgKGlmIChvciAobnVsbCBzb3J0ZWQpICg8IHggKGNhciBzb3J0ZWQpKSkKICAgICAgKGNvbnMgeCBzb3J0ZWQpCiAgICAgIChjb25zIChjYXIgc29ydGVkKSAoaW5zZXJ0LWludG8tc29ydGVkIHggKGNkciBzb3J0ZWQpKSkpKQoKOzsg0KDQtdC60YPRgNGB0LjQstC90LDRjyDRgdC+0YDRgtC40YDQvtCy0LrQsCDQstGB0YLQsNCy0LrQsNC80LgKKGRlZnVuIGluc2VydGlvbi1zb3J0IChsc3QpCiAgKGlmIChudWxsIGxzdCkgbmlsCiAgICAgIChpbnNlcnQtaW50by1zb3J0ZWQgKGNhciBsc3QpIChpbnNlcnRpb24tc29ydCAoY2RyIGxzdCkpKSkpCgo7OyDQoNC10LrRg9GA0YHQuNCy0L3Ri9C5IG1hcAooZGVmdW4gbWFwLXJlYyAoZiBsc3QpCiAgKGlmIChudWxsIGxzdCkgbmlsIChjb25zIChmdW5jYWxsIGYgKGNhciBsc3QpKSAobWFwLXJlYyBmIChjZHIgbHN0KSkpKSkKCihkZWZ1biBhbGwtZW1wdHktcCAoc2xpc3QpCiAgKGlmIChudWxsIHNsaXN0KSB0CiAgICAgIChpZiAobnVsbCAoY2FyIHNsaXN0KSkgKGFsbC1lbXB0eS1wIChjZHIgc2xpc3QpKSBuaWwpKSkKCihkZWZ1biB0YWtlLWhlYWRzLW9uY2UgKHNsaXN0KQogIChpZiAobnVsbCBzbGlzdCkgbmlsCiAgICAgIChsZXQgKChoIChjYXIgc2xpc3QpKSkKICAgICAgICAoaWYgKG51bGwgaCkgKHRha2UtaGVhZHMtb25jZSAoY2RyIHNsaXN0KSkKICAgICAgICAgICAgKGNvbnMgKGNhciBoKSAodGFrZS1oZWFkcy1vbmNlIChjZHIgc2xpc3QpKSkpKSkpCgooZGVmdW4gdGFpbHMgKHNsaXN0KQogIChpZiAobnVsbCBzbGlzdCkgbmlsCiAgICAgIChsZXQgKChoIChjYXIgc2xpc3QpKSkKICAgICAgICAoY29ucyAoaWYgKG51bGwgaCkgbmlsIChjZHIgaCkpICh0YWlscyAoY2RyIHNsaXN0KSkpKSkpCgooZGVmdW4gaW50ZXJsZWF2ZSAoc2xpc3QpCiAgKGxhYmVscyAoKGludGVyLXJlYyAoc2xpc3QpCiAgICAgICAgICAgICAoaWYgKGFsbC1lbXB0eS1wIHNsaXN0KSBuaWwKICAgICAgICAgICAgICAgICAoYXBwZW5kICh0YWtlLWhlYWRzLW9uY2Ugc2xpc3QpCiAgICAgICAgICAgICAgICAgICAgICAgICAoaW50ZXItcmVjICh0YWlscyBzbGlzdCkpKSkpKSAKICAgIChpbnRlci1yZWMgc2xpc3QpKSkKCihkZWZ1biBzaGVsbC1zb3J0LWJ5LWdhcHMgKGxzdCBnYXBzKQogIChpZiAobnVsbCBnYXBzKSBsc3QKICAgICAgKGxldCAoKGcgKGNhciBnYXBzKSkpCiAgICAgICAgKHNoZWxsLXNvcnQtYnktZ2FwcwogICAgICAgICAoaW50ZXJsZWF2ZSAobWFwLXJlYyAjJ2luc2VydGlvbi1zb3J0IChzcGxpdC1ieS1nYXAgbHN0IGcpKSkKICAgICAgICAgKGNkciBnYXBzKSkpKSkKCihkZWZ1biBzaGVsbC1zb3J0IChsc3QpCiAgItCn0LjRgdGC0L4g0YTRg9C90LrRhtC40L7QvdCw0LvRjNC90LDRjyDRgdC+0YDRgtC40YDQvtCy0LrQsCDQqNC10LvQu9CwINC00LvRjyDRgdC/0LjRgdC60LAgTElTVCAo0L/QviDQstC+0LfRgNCw0YHRgtCw0L3QuNGOKS4iCiAgKGxldCAoKG4gKGxpc3QtbGVuZ3RoIGxzdCkpKQogICAgKHNoZWxsLXNvcnQtYnktZ2FwcyBsc3QgKHNlZGdld2ljay1nYXBzIG4pKSkpCgo7OzsgLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0KOzs7INCf0YDQuNC80LXRgNGLINC40YHQv9C+0LvRjNC30L7QstCw0L3QuNGPCjs7OyAtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLQooZGVmdW4gcnVuLXNoZWxsLXNvcnQtZXhhbXBsZXMgKCkKICAi0J/QvtC60LDQt9Cw0YLRjCDQv9GA0LjQvNC10YDRiyDRgNCw0LHQvtGC0Ysgc2hlbGwtc29ydC4g0JLQvtC30LLRgNCw0YnQsNC10YIgTklMINC/0L7RgdC70LUg0LLRi9Cy0L7QtNCwLiIKICAoZm9ybWF0IHQgIn4lU2hlbGwtc29ydCBleGFtcGxlczp+JX4lIikKICAoZm9ybWF0IHQgIjEpIH5TIC0+IH5TfiUiICcoMyAxIDQgMSA1IDkgMiA2IDUpIChzaGVsbC1zb3J0ICcoMyAxIDQgMSA1IDkgMiA2IDUpKSkKICAoZm9ybWF0IHQgIjIpIH5TIC0+IH5TfiUiICcoMTAgOSA4IDcgNiA1IDQgMyAyIDEpIChzaGVsbC1zb3J0ICcoMTAgOSA4IDcgNiA1IDQgMyAyIDEpKSkKICAoZm9ybWF0IHQgIjMpIH5TIC0+IH5TfiUiICcoKSAoc2hlbGwtc29ydCAnKCkpKQogIChmb3JtYXQgdCAiNCkgflMgLT4gflN+JSIgJyg0MikgKHNoZWxsLXNvcnQgJyg0MikpKQogIChmb3JtYXQgdCAiNSkgflMgLT4gflN+JSIgJyg1IDMgNSAzIDIgMSA0KSAoc2hlbGwtc29ydCAnKDUgMyA1IDMgMiAxIDQpKSkKICBuaWwpCg==