recursioncommon-lispstack-overflowcompiler-optimizationsbcl

Why does my recursive (non tail) implementation of quick-sort NOT cause a stack overflow? Using Common Lisp, SBCL


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.


Solution

  • 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.