# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1479843337 0
# Node ID 9f549a9639ca566b87545e01041817ee3ac5c0c3
# Parent  864abae279b7207e2b3e4c5041d52e06be3d25cf
Merge sort

diff -r 864abae279b7 -r 9f549a9639ca src/sorting.lisp
--- a/src/sorting.lisp	Mon Nov 21 11:22:22 2016 +0000
+++ b/src/sorting.lisp	Tue Nov 22 19:35:37 2016 +0000
@@ -29,8 +29,53 @@
              (aref vector smallest)))
   vector)
 
+(defun merge-with-temporary (vector temp lstart lsize rstart rsize
+                             &key (predicate #'<))
+  "Merge two consecutive subvectors destructively, using `temp` for storage."
+  (let ((lend (+ lstart lsize))
+        (rend (+ rstart rsize)))
+    (recursively ((i 0) (l lstart) (r rstart))
+      (cond
+        ((= l lend) (replace temp vector ; Done with l, bulk-copy the rest of r
+                             :start1 i
+                             :start2 r :end2 rend))
+        ((= r rend) (replace temp vector ; Done with r, bulk-copy the rest of l
+                             :start1 i
+                             :start2 l :end2 lend))
+        ;; Take r only if it's strictly less than l, so we have a stable mege
+        ((funcall predicate (aref vector r) (aref vector l))
+         (setf (aref temp i) (aref vector r))
+         (recur (1+ i) l (1+ r)))
+        (t ; Otherwise l <= r, so take l
+         (setf (aref temp i) (aref vector l))
+         (recur (1+ i) (1+ l) r)))))
+  (replace vector temp :start1 lstart :end2 (+ lsize rsize)))
+
+(defun merge-sort (vector)
+  "Merge-sort `vector` destructively.
+
+  A single vector the same size as `vector` will be consed internally for
+  temporary storage.
+
+  "
+  (let ((temp (make-array (length vector)))) ; just cons one temp array
+    (recursively ((start 0)
+                  (size (length vector)))
+      (when (>= size 2)
+        (let* ((half (floor size 2))
+               (left-start start)
+               (right-start (+ start half))
+               (left-size half)
+               (right-size (- size half)))
+          (recur left-start left-size)
+          (recur right-start right-size)
+          (merge-with-temporary vector temp
+                                left-start left-size
+                                right-start right-size)))))
+  vector)
 
 
-(defparameter *v* #(1 3 7 0 2 1 4))
+(defparameter *v* #(1 3 7 0 2))
 ; (selection-sort *v*)
 ; (bubble-sort *v*)
+; (merge-sort *v*)