I was planning to change this function to avoid stack-overflow, but my recursive and non-tail call optimized implementation doesn't seem to overflow, and I don't know why. The largest array I tried had 10 million elements.
(sort-array-from-to (random-array 10000000) (lambda (a b) (- b a)) 0 1000000)
I'm using SBCL to run my Common Lisp code from SLIME. Here is my implementation:
(defun sort-array-from-to (xs cmp-fn beg end)
"Quick-Sort just the elements of the simple array XS from BEG idx to
just before END using CMP-FN. The CMP-FN should return an integer < 0
to indicate <, 0 for =, and n > 0 for >."
;; TODO convert to cps trampoline to avoid stack overflow
(when (<= (- end beg) 1) (return-from sort-array-from-to xs))
(let ((pivot (partition xs cmp-fn beg end)))
(array-swap xs beg pivot)
(sort-array-from-to xs cmp-fn beg pivot)
(sort-array-from-to xs cmp-fn (1+ pivot) end)))
(defun array-swap (xs i j)
"Destructively swap elements of array XS at I and J"
(let ((tmp (aref xs i)))
(setf (aref xs i)
(aref xs j))
(setf (aref xs j)
tmp))
xs)
(defun partition (xs cmp-fn b j)
"Used in quicksort. Returns idx of new pivot point after partitioning XS destructively."
(let ((pivot-val (aref xs b))
(i b))
(loop until (>= i j) do
(incf i 1)
(loop until (or (= i (1- j))
(< (funcall cmp-fn
(aref xs i)
pivot-val)
0))
do (incf i 1))
(incf j -1)
(loop until (or (= j b)
(> (funcall cmp-fn
(aref xs j)
pivot-val)
0))
do (incf j -1))
;; If j get to b and every j is >= pivot-val, the pivot should stay put.
(when (= j b) (loop-finish))
(when (< i j)
(array-swap xs i j)))
j))
UPDATE The program worked for an array of size up to 1 million, and it took less than a minute. I would think that would be more than enough to cause stack overflow no? But for 10 million, I checked on SLIME after a while and it said "Lisp disconnected". I don't know if that could be caused by stack overflow.
As a comment says, the recursion depth goes logarithmically with the size of the array assuming non-awful pivot selection. That means you need really enormous arrays to run into stack overflow problems.
I modified your code like this:
(defun sort-array-from-to (xs cmp-fn beg end depth depther)
"Quick-Sort just the elements of the simple array XS from BEG idx to
just before END using CMP-FN. The CMP-FN should return an integer < 0
to indicate <, 0 for =, and n > 0 for >."
;; TODO convert to cps trampoline to avoid stack overflow
(funcall depther depth)
(when (<= (- end beg) 1) (return-from sort-array-from-to xs))
(let ((pivot (partition xs cmp-fn beg end)))
(array-swap xs beg pivot)
(sort-array-from-to xs cmp-fn beg pivot (1+ depth) depther)
(sort-array-from-to xs cmp-fn (1+ pivot) end (1+ depth) depther)))
And then wrote these two:
(defun random-array (n)
(let ((a (make-array (list n) :element-type 'fixnum)))
(dotimes (i n a)
(setf (aref a i) (random most-positive-fixnum)))))
(defun depth (n)
(let ((a (random-array n))
(d 0))
(sort-array-from-to a (lambda (a b) (- b a)) 0 n
0 (lambda (depth)
(setf d (max depth d))))
(dotimes (i (1- n))
(unless (<= (aref a i) (aref a (1+ i)))
(error "unsort")))
d))
And now you can check what the depth is. It's obviously a little variable but it empirically appears to be about ~2.5 log(n) where n is number of elements.
Incidentally your array-swap
should just be rotatef
.