← All source

Common Lisp — quicksort.lisp

Common Lisp (SBCL) — Randomized Quicksort

Toolchain

Build / run

SBCL compiles top-level defuns to native machine code automatically (no separate "build" step); (declaim (optimize (speed 3) (safety 0) (debug 0))) at the top of quicksort.lisp requests maximum-speed native compilation for the sort routine.

The default SBCL dynamic-space (heap) size of 1024 MB is too small to hold the largest arrays this experiment allocates (an n = 65,536,000-element simple-array of fixnum is ~512 MB by itself, and two are briefly live across a GC), so the heap is raised to 16 GB via --dynamic-space-size. Exact command used:

wsl.exe -d Ubuntu -- bash -c "cd '/mnt/c/Users/granite/Documents/DSU/Algorithms 482/3/HW3/lisp' && sbcl --dynamic-space-size 16384 --script quicksort.lisp"

--script runs the file non-interactively (loads and evaluates top to bottom, then exits) — no REPL is started, which is what a batch benchmark run needs. Note: this SBCL binary distribution's own run-sbcl.sh script is broken/corrupted in this environment — do not use it; invoke the sbcl command directly as shown above.

Output: results print to stdout as they're produced, and are also written to HW3/results/lisp.csv (path ../results/lisp.csv relative to this folder, which the script opens with with-open-file).

;;;; quicksort.lisp
;;;; CSC 482 HW3 - Language Comparison
;;;; Randomized Quicksort in Common Lisp (SBCL), per CLRS Ch. 5
;;;; RANDOMIZED-QUICKSORT / RANDOMIZED-PARTITION pseudocode.
;;;;
;;;; No external code used - original implementation.
;;;; No Quicklisp packages; standard library only.

(declaim (optimize (speed 3) (safety 0) (debug 0) (compilation-speed 0)))

(defun randomized-partition (a p r)
  "Lomuto partition of the simple-vector A over inclusive range [P, R],
   with the pivot chosen uniformly at random from [P, R] and swapped into
   the last position R before running the standard Lomuto partition.
   Returns the final index of the pivot."
  (declare (type (simple-array fixnum (*)) a)
           (type fixnum p r))
  (let ((i (+ p (random (the fixnum (1+ (- r p)))))))
    (declare (type fixnum i))
    ;; swap a[i] and a[r] to move the random pivot into place
    (rotatef (aref a i) (aref a r))
    (let ((pivot (aref a r))
          (store p))
      (declare (type fixnum pivot store))
      (loop for j of-type fixnum from p below r do
        (when (<= (aref a j) pivot)
          (rotatef (aref a store) (aref a j))
          (incf store)))
      (rotatef (aref a store) (aref a r))
      store)))

(defun randomized-quicksort (a p r)
  "In-place randomized quicksort on simple-vector A over inclusive
   range [P, R], per CLRS RANDOMIZED-QUICKSORT. Iterative with an
   explicit stack (mirrors the recursive pseudocode's behavior) so
   large N does not risk blowing the call stack."
  (declare (type (simple-array fixnum (*)) a)
           (type fixnum p r))
  (let ((stack (list (cons p r))))
    (loop while stack do
      (let* ((bounds (pop stack))
             (lo (car bounds))
             (hi (cdr bounds)))
        (declare (type fixnum lo hi))
        (when (< lo hi)
          (let ((q (randomized-partition a lo hi)))
            (declare (type fixnum q))
            (push (cons lo (1- q)) stack)
            (push (cons (1+ q) hi) stack))))))
  a)

(defun make-random-vector (n)
  "Generate a fresh simple-vector of N random fixnums in [0, 1000000)."
  (declare (type fixnum n))
  (let ((v (make-array n :element-type 'fixnum)))
    (dotimes (i n)
      (setf (aref v i) (random 1000000)))
    v))

(defun run-experiment ()
  (let ((n 1000)
        (iteration 0)
        (results '()))
    (declare (type fixnum n iteration))
    (with-open-file (out "../results/lisp.csv"
                          :direction :output
                          :if-exists :supersede
                          :if-does-not-exist :create)
      (format out "n,time_seconds~%")
      (format t "n,time_seconds~%")
      (finish-output out)
      (finish-output t)
      (loop
        (let* ((vec (make-random-vector n))
               (start (get-internal-real-time))
               (dummy (randomized-quicksort vec 0 (1- n)))
               (end (get-internal-real-time))
               (elapsed (/ (float (- end start) 1.0d0)
                           (float internal-time-units-per-second 1.0d0))))
          (declare (ignore dummy))
          (push (cons n elapsed) results)
          (format out "~d,~,9f~%" n elapsed)
          (format t "~d,~,9f~%" n elapsed)
          (finish-output out)
          (finish-output t)
          (incf iteration)
          (when (or (> elapsed 4.0d0)
                    (>= iteration 25)
                    (> (* n 2) 200000000))
            (return)))
        (setf n (* n 2))))
    (nreverse results)))

(run-experiment)