;;; File:
;;;   mergesort.ss
;;; Author:
;;;   Samuel A. Rebelsky
;;; Summary:
;;;   Procedures for sorting stuff using the legendary
;;;   merge sort procedure.
;;; Version:
;;;   1.1 of April 2001
;;; Contents:
;;;   Primary Procedures:
;;;     (merge-sort stuff get-key may-precede?)
;;;       Sort a list.
;;;     (merge sorted1 sorted2 get-key may-precede?)
;;;       Merge two sorted lists.
;;; History
;;;   Wednesday, 22 November 2000 [v 1.0]
;;;     Created.
;;;   Tuesday, 24 April 2001 [v 1.1]
;;;     Renamed the comparison procedure to may-precede?.
;;;     Updated documentation.
;;;     Added a few more internal comments.
;;;     Changed the return type of split to "two values".

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

;;; Procedure:
;;;   merge-sort
;;; Parameters:
;;;   stuff, a list to sort
;;;   get-key, a procedure to extract keys from list values.
;;;   may-precede?, a binary predicate that compares keys.
;;; Purpose:
;;;   Sort stuff by key.
;;; Produces:
;;;   sorted, a sorted list
;;; Preconditions:
;;;   get-key can be applied to all elements of stuff.
;;;   may-precede? can be applied to any two keys
;;;     extracted by get-key.
;;;   may-precede? represents a transitive operation.
;;; Postconditions:
;;;   The result list is sorted.  That is, the key of any
;;;     element may precede the key of any subsequent element.
;;;     In Scheme, we'd say that
;;;       (may-precede? (get-key (list-ref sorted i))
;;;                     (get-key (list-ref sorted (+ i 1))))
;;;     holds.
;;;   sorted and stuff have the same elements (although potentially
;;;     in different orders).
;;;   Does not affect stuff.
;;;   sorted may share cons cells with stuff.
;;; Examples:
;;;   To sort values, a list of numbers, in increasing order.
;;;     (merge-sort values id <=)
;;;   To sort values, a list of numbers, in decreasing order.
;;;     (merge-sort values id >=)
;;;   To sort people, a list of (last-name first-name phone-number)
;;;     triplets, by phone number
;;;     (merge-sort people caddr string<=?)
(define merge-sort
  (lambda (stuff get-key may-precede?)
    ; If there are only zero or one elements in the list,
    ; the list is already sorted.
    (if (or (null? stuff) (null? (cdr stuff)))
        stuff
        ; Otherwise, 
        ;   split the list in half,
        ;   sort each half,
        ;   and then merge the sorted halves.
        (call-with-values (lambda () (split stuff))
                          (lambda (some rest)
                            (merge (merge-sort some get-key may-precede?)
                                   (merge-sort rest get-key may-precede?)
                                   get-key may-precede?))))))

;;; Procedure:
;;;   merge
;;; Parameters:
;;;   sorted1, a sorted list.
;;;   sorted2, a sorted list.
;;;   get-key, a unary procedure to extract the key from each value
;;;   may-precede?, a binary predicate that compares keys
;;; Purpose:
;;;   Merge the two lists.
;;; Produces:
;;;   sorted, a sorted list.
;;; Preconditions:
;;;   get-key can be applied to all elements of sorted1.
;;;   get-key can be applied to all elements of sorted2.
;;;   may-precede? can be applied to any two keys
;;;     extracted by get-key.
;;;   may-precede? represents a transitive operation.
;;;   sorted1 and sorted2 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 sorted1 appears in sorted.
;;;   Every element in sorted2 appears in sorted.
;;;   Every element in sorted appears in sorted1 or sorted2.
;;;   Does not affect sorted1 or sorted2.
;;;   sorted may share cons cells with sorted1 or sorted2.
(define merge
  (lambda (sorted1 sorted2 get-key may-precede?)
    (cond
      ; If the first list is empty, return the second
      ((null? sorted1) sorted2)
      ; If the second list is empty, return the first
      ((null? sorted2) sorted1)
      ; If the first element of the first list is smaller,
      ; make it the first element of the result and recurse.
      ((may-precede? (get-key (car sorted1))
                     (get-key (car sorted2)))
       (cons (car sorted1) 
             (merge (cdr sorted1) sorted2 get-key may-precede?)))
      ; Otherwise, do something similar using the first element
      ; of the second list
      (else
       (cons (car sorted2) 
             (merge sorted1 (cdr sorted2) get-key may-precede?))))))

;;; Procedure:
;;;   split
;;; Parameters:
;;;   lst, a list
;;; Purpose:
;;;   Split a list into two nearly-equal halves.
;;; Produces:
;;;   firsthalf, a list
;;;   secondhalf, a list
;;; Preconditions:
;;;   lst is a list.
;;; Postconditions:
;;;   Every element in the original list is in exactly one of the 
;;;     firsthalf and secondhalf.
;;;   No other elements are in firsthalf or secondhalf.
;;;   Does not modify lst.
;;;   Either firsthalf or secondhalf may share cons cells with lst.
(define split
  (lambda (lst)
    ;;; helper
    ;;;   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) ; Elements remaining to be used
                 (revacc null)   ; Accumulated initial elements
                 (count          ; How many elements left to use
                  (quotient (length lst) 2)))
      ; If no elements remain to be used,
      (if (= count 0)
          ; The first half is in revacc and the second half
          ; consists of any remaining elements.
          (values (reverse revacc) remaining)
          ; Otherwise, use up one more element.
          (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
;;;   len, an integer
;;; Purpose:
;;;   Produces a list of "random" values.
;;; Preconditions:
;;;   max > 0
;;;   len >= 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 len)
    (if (= len 0) null
        (cons (random (+ max 1)) (random-list max (- len 1))))))