;;; File:
;;;   mergesort.ss
;;; Author:
;;;   Samuel A. Rebelsky
;;; Summary:
;;;   Procedures for sorting stuff using the legendary
;;;   merge sort procedure.
;;; Version:
;;;   1.0 of November 2000
;;; Contents:
;;;   Primary Procedures:
;;;     (merge-sort stuff get-key less-than-or-equal?)
;;;       Sort a list.
;;;     (merge sort1 sort2 get-key less-than-or-equal?)
;;;       Merge two sorted lists.
;;; History
;;;   Wednesday, 22 November 2000 [v 1.0]
;;;     Created

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Primary Procedures

;;; Procedure:
;;;   merge-sort
;;; Parameters:
;;;   stuff, a list to sort
;;;   get-key, a unary procedure to extract the key from each value
;;;   less-than-or-equal?, a binary predicate that compares keys
;;; Purpose:
;;;   Sort the list based on keys.
;;; Produces:
;;;   A sorted list.
;;; Preconditions:
;;;   get-key can be applied to all elements of stuff.
;;;   less-than-or-equal? can be applied to any two keys
;;;     extracted by get-key.
;;;   less-than-or-equal? represents a transitive operation.
;;; Postconditions:
;;;   The result list is sorted.  That is, the key of any
;;;     element is less than or equal to the key of any
;;;     subsequent element.
;;;   Every element in the original list appears in the
;;;     result list.
;;;   Every element in the result list appears in the original
;;;     list.
;;;   The original list is not affected.
;;;   The result list may share cons cells with the original list.
(define merge-sort
  (lambda (stuff get-key less-than-or-equal?)
    (if (<= (length stuff) 1)
        stuff
        (let* ((halves (split stuff))
               (firsthalf (car halves))
               (secondhalf (cadr halves)))
          (merge (merge-sort firsthalf get-key less-than-or-equal?)
                 (merge-sort secondhalf get-key less-than-or-equal?)
                 get-key less-than-or-equal?)))))

;;; Procedure:
;;;   merge
;;; Parameters:
;;;   sort1, a sorted list
;;;   sort2, a sorted list'
;;;   get-key, a unary procedure to extract the key from each value
;;;   less-than-or-equal?, a binary predicate that compares keys
;;; Purpose:
;;;   Merge the two lists.
;;; Produces:
;;;   A sorted list.
;;; Preconditions:
;;;   get-key can be applied to all elements of stuff.
;;;   less-than-or-equal? can be applied to any two keys
;;;     extracted by get-key.
;;;   less-than-or-equal? represents a transitive operation.
;;;   The parameter lists are sorted.  For each list, the key of 
;;;     any element is less than or equal to the key of any
;;;     subsequent element.
;;; Postconditions:
;;;   The result list is sorted.
;;;   Every element in either parameter list appears in the
;;;     result list.
;;;   Every element in the result list appears in one of the
;;;     parameter lists.
;;;   The parameter lists are not affected.
;;;   The result list may share cons cells with one or both of
;;;     the parameter lists.
(define merge
  (lambda (sort1 sort2 get-key less-than-or-equal?)
    (cond
      ; If the first list is empty, return the second
      ((null? sort1) sort2)
      ; If the second list is empty, return the first
      ((null? sort2) sort1)
      ; If the first element of the first list is smaller,
      ; make it the first element of the result and recurse.
      ((less-than-or-equal? (get-key (car sort1))
                            (get-key (car sort2)))
       (cons (car sort1) 
             (merge (cdr sort1) sort2 get-key less-than-or-equal?)))
      ; Otherwise, do something similar using the first element
      ; of the second list
      (else
       (cons (car sort2) 
             (merge sort1 (cdr sort2) get-key less-than-or-equal?))))))

;;; Procedure:
;;;   split
;;; Parameters:
;;;   A list
;;; Purpose:
;;;   Split a list into two nearly-equal halves.
;;; Produces:
;;;   A list of two lists
;;; Preconditions:
;;;   The parameter is a list.
;;; Postconditions:
;;;   Produces a pair of lists.
;;;   Every element in the original list is in exactly one of the 
;;;     result lists.
;;;   No other elements are in the result lists.
;;;   Does not modify the original list.
;;;   Either list may share cons cells with the original list.
(define split
  (lambda (lst)
    ;;; Remove the first count elements of a list.  Return the
    ;;; pair consisting of the removed elements (in order) and
    ;;; the remaining elements.
    (let helper ((remaining lst)
                 (revacc null)
                 (count (quotient (length lst) 2)))
      (if (= count 0)
          (list (reverse revacc) remaining)
          (helper (cdr remaining)
                  (cons (car remaining) revacc)
                  (- count 1))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Utility Procedures

;;; Procedure:
;;;   id
;;; Parameters:
;;;   A value
;;; Purpose:
;;;   Return the parameter.  Useful for cases in which the key of
;;;   a value is the value.
;;; Produces:
;;;   The same value.
;;; Preconditions:
;;;   None
;;; Postconditions:
;;;   Does not affect the parameter.
(define id (lambda (x) x))

;;; Procedure:
;;;   random-list
;;; Parameters:
;;;   max, the largest value to be produced
;;;   length, an integer
;;; Purpose:
;;;   Produces a list of "random" values.
;;; Preconditions:
;;;   max > 0
;;;   length >= 0
;;; Postconditions:
;;;   The result list has length length.
;;;   Every value in the result list is between 0 and max, inclusive.
;;;   The result list is hard to predict.
(define random-list
  (lambda (max length)
    (if (= length 0) null
        (cons (random (+ max 1)) (random-list max (- length 1))))))