Merge Sort in Elisp

classes.el

;; Sort set of courses in decreasing order (latest date first)
;; Easiest way to evaluate: paste the code in an emacs buffer. Change the mode
;; to lisp-interaction-mode. Go to the end of "setq courses" and type C-x C-e
;; (eval-last-sexp), go to the end of "defun course-sort" and type C-x C-e,
;; and then go to the end of "course-sort courses" and type C-j. The sorted
;; list will print out below the command inside the buffer.

(setq courses '("16 Oct 2013 - Circuits 1: https://www.edx.org/course/mitx/mitx-6-002x-circuits-electronics-1130"
                "7  Oct 2013 - 3d Graphics: https://www.edx.org/course/uc-berkeleyx/uc-berkeleyx-cs-184-1x-foundations-1003"
                "7  Jan 2014 - Principles of Econ: https://www.edx.org/course/caltechx/caltechx-ec1011x-principles-economics-1286"
                "13 Jan 2014 - Elec & Magn: https://www.edx.org/course/ricex/ricex-phys102x-electricity-magnetism-1356"
                "15 Jan 2014 - Linear Alg: https://www.edx.org/course/utaustinx/utaustinx-ut-5-01x-linear-algebra-1162"
                "22 Jan 2014 - Embedded: https://www.edx.org/course/utaustinx/utaustinx-ut-6-01x-embedded-systems-1172"
                "31 Jan 2014 - Algos:    https://www.coursera.org/course/algs4partI"
                "7  Feb 2014 - Analysis of Algs: https://www.coursera.org/course/aofa"
                "11 Feb 2013 - Compilers: https://www.coursera.org/course/compilers"
                "23 Sep 2013 - Arch: https://www.coursera.org/course/comparch"
                "6  Jan 2014 - Networks: https://www.coursera.org/course/comnetworks"
                "13 Jan 2014 - AI Planning: https://www.coursera.org/course/aiplan"))


(defun course-sort (courses)
  (defun course-sort-create-date-num-pair (course)
    (let ((index 0)
          (prev-index 0)
          (date-num 0))
      ;; Parse day
      (while (not (equal (string-to-char " ") (aref course index)))
        (setq index (+ 1 index)))
      (setq date-num (+ date-num
                        (string-to-number (substring course prev-index index))))
      (while (equal (string-to-char " ") (aref course index))
        (setq index (+ 1 index)))
      (setq prev-index index)
      ;; Parse month
      (while (not (equal (string-to-char " ") (aref course index)))
        (setq index (+ 1 index)))
      (setq date-num (+ date-num
                        (* 100
                           (cdr (assoc (substring course prev-index index) months)))))
      (while (equal (string-to-char " ") (aref course index))
        (setq index (+ 1 index)))
      (setq prev-index index)
      ;; Parse year
      (while (not (equal (string-to-char " ") (aref course index)))
        (setq index (+ 1 index)))
      (setq date-num (+ date-num
                        (* 10000
                           (string-to-number (substring course prev-index index)))))
      (cons date-num course)))
  
  (defun course-sort-merge-sort (date-list)
    
    (defun course-sort-merge (left-list right-list)
      (let ((merged-list nil))
        (setq left-list (reverse left-list))
        (setq right-list (reverse right-list))
        (while right-list
          (let ((left (car left-list))
                (left-num (caar left-list))
                (right (car right-list))
                (right-num (caar right-list)))
            (cond ((or (equal left-num nil)
                       (> right-num left-num))
                   (setq merged-list (cons right merged-list))
                   (setq right-list (cdr right-list)))
                  (t
                   (setq merged-list (cons left merged-list))
                   (setq left-list (cdr left-list))))))
        (while left-list
          (let ((left (car left-list)))
            (setq merged-list (cons left merged-list))
            (setq left-list (cdr left-list))))
        merged-list))
    
    (let* ((len (length date-list))
           (mid (/ len 2))
           (left nil)
           (right nil)
           (index 0))
      (if (<= len 1)
          date-list
        (progn
          (while (/= index mid)
            (setq left (cons (car date-list) left))
            (setq date-list (cdr date-list))
            (setq index (+ 1 index)))
          (while date-list
            (setq right (cons (car date-list) right))
            (setq date-list (cdr date-list)))
          (setq left (course-sort-merge-sort left))
          (setq right (course-sort-merge-sort right))
          (course-sort-merge left right)))))
  
  (let ((date-list nil)
        (months '(("Jan" . 1)
                  ("Feb" . 2)
                  ("Mar" . 3)
                  ("Apr" . 4)
                  ("May" . 5)
                  ("Jun" . 6)
                  ("Jul" . 7)
                  ("Aug" . 8)
                  ("Sep" . 9)
                  ("Oct" . 10)
                  ("Nov" . 11)
                  ("Dec" . 12))))
    (while courses
      (let ((course (car courses)))
        (setq date-list (cons (course-sort-create-date-num-pair course) date-list))
      (setq courses (cdr courses))))
    (setq date-list (course-sort-merge-sort date-list))
    (setq date-list (reverse date-list))
    (while date-list
      (print (cdar date-list))
      (setq date-list (cdr date-list)))))

(course-sort courses)