aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

all tasks

Browse source
This commit is contained in:
Ingy döt Net 2013-04-11 01:07:29 -07:00
parent b83f433714
commit 68f8f3e56b
14735 changed files with 178959 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

20
Task/Sorting-algorithms-Shell-sort/Common-Lisp/sorting-algorithms-shell-sort.lisp Normal file
View file

@ -0,0 +1,20 @@
(defun gap-insertion-sort (array predicate gap)
(let ((length (length array)))
(if (< length 2) array
(do ((i 1 (1+ i))) ((eql i length) array)
(do ((x (aref array i))
(j i (- j gap)))
((or (< (- j gap) 0)
(not (funcall predicate x (aref array (1- j)))))
(setf (aref array j) x))
(setf (aref array j) (aref array (- j gap))))))))
(defconstant +gaps+
'(1750 701 301 132 57 23 10 4 1)
"The best sequence of gaps, according to Marcin Ciura.")
(defun shell-sort (array predicate &optional (gaps +gaps+))
(assert (eql 1 (car (last gaps))) (gaps)
"Last gap of ~w is not 1." gaps)
(dolist (gap gaps array)
(gap-insertion-sort array predicate gap)))