;;; File:
;;;   sorts.scm
;;; Author:
;;;   Samuel A. Rebelsky
;;; Version:
;;;   0.1 of 15 November 2006
;;; Summary:
;;;   A variety of implementations of sorting.

; +-----------+-------------------------------------------------------
; | Libraries |
; +-----------+

(load "/home/rebelsky/Web/Courses/CS151/2006F/Examples/unit-test.ss")
(load "/home/rebelsky/Web/Courses/CS151/2006F/Examples/analyst.scm")


; +-------------------+-----------------------------------------------
; | General Utilities |
; +-------------------+

;;; Procedure:
;;;   random-element
;;; Parameters:
;;;   lst, a list
;;; Purpose:
;;;   Select an "unpredicatable" element of lst.
;;; Produces:
;;;   val, a value.
;;; Preconditions:
;;;   lst is nonempty.
;;; Postconditions:
;;;   val is an element of lst.
;;;   Each element of lst is equally likely.
(define random-element
  (lambda (lst)
    (list-ref lst (random (length lst)))))

;;; Procedure:
;;;   random-list
;;; Parameters:
;;;   max, the largest value to be produced
;;;   len, an integer
;;; Purpose:
;;;   Produces a list of "random" values.
;;; Produces:
;;;   lst, a list.
;;; Preconditions:
;;;   max > 0
;;;   len >= 0
;;; Postconditions:
;;;   lst 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))))))

; +----------------+--------------------------------------------------
; | Insertion Sort |
; +----------------+

;;; Procedure:
;;;   insertion-sort
;;; Parameters:
;;;   lst, a list
;;;   may-precedes?, a binary predicate
;;; Purpose:
;;;   Sorts lst
;;; Produces:
;;;   sorted, a list 
;;; Preconditions:
;;;   (none)
;;; Postconditions:
;;;   sorted is a permutation of lst.
;;;   sorted is organized in increasing order.  That is, 
;;;     (may-precede? (list-ref sorted i) (list-ref sorted (+ i 1)))
;;;     for all reasonable values of i.
(define$ insertion-sort
  (lambda (lst may-precede?)
    (let helper ((unsorted lst)  ; The remaining unsorted values
                 (sorted null))      ; The sorted values
      (if (null? unsorted) sorted
          (helper (cdr unsorted) 
                  (insert (car unsorted) sorted may-precede?))))))

;;; Procedure:
;;;   insert
;;; Parameters:
;;;   new-value, a Scheme value
;;;   sorted, a Vector
;;;   may-precede?, a binary predicate
;;; Purpose:
;;;   Insert new-value into the proper place in sorted.
;;; Produces:
;;;   new-ls, a new list of real numbers
;;; Preconditions:
;;;   may-precede? is transitive and reflexive. [Unverified]
;;;   sorted is arranged in increasing order.   That is,
;;;     (may-precede? (list-ref sorted i) (list-ref sorted (+ i 1)))
;;;     for all reasonable values of i.  [Unverified]
;;; Postconditions:
;;;   new-ls is arranged in increasing order.
;;;   new-ls is a permutation of (cons new-value sorted).
(define$ insert
  (lambda (new-value sorted may-precede?)
    (let kernel ((rest sorted)
                 (bypassed null))
      (cond ((null? rest) (reverse (cons new-value bypassed)))
            ((may-precede? new-value (car rest))
             (append (reverse (cons new-value bypassed)) rest))
            (else (kernel (cdr rest) (cons (car rest) bypassed)))))))

; +------------+------------------------------------------------------
; | Merge Sort |
; +------------+

;;; Procedure:
;;;   merge-sort
;;; Parameters:
;;;   stuff, a list to sort
;;;   may-precede?, a binary predicate 
;;; Purpose:
;;;   Sort stuff.
;;; Produces:
;;;   sorted-stuff, a sorted list
;;; Preconditions:
;;;   may-precede? can be applied to any two elements of stuff.
;;;   may-precede? represents a transitive operation.
;;;   stuff is not empty.
;;; Postconditions:
;;;   sorted-stuff 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? (list-ref sorted i) (list-ref sorted (+ i 1)))
;;;   sorted-stuff is a permutation of stuff.
;;;   Does not affect stuff.
;;;   sorted-stuff may share cons cells with stuff.
(define$ merge-sort
  (lambda (stuff may-precede?)
    (if (or (null? stuff) (null? (cdr stuff)))
        stuff
        (let* ((halves (split stuff))
               (some (car halves))
               (rest (cadr halves)))
          (merge (merge-sort some may-precede?)
                 (merge-sort rest may-precede?)
                 may-precede?)))))

;;; Procedure:
;;;   merge
;;; Parameters:
;;;   sorted1, a sorted list.
;;;   sorted2, a sorted list.
;;;   may-precede?, a binary predicate that compares keys
;;; Purpose:
;;;   Merge the two lists.
;;; Produces:
;;;   sorted, a sorted list.
;;; Preconditions:
;;;   may-precede? can be applied to any two values in sorted1 or sorted2
;;;   may-precede? represents a transitive operation.
;;;   sorted1 and sorted2 are sorted by may-precede?.  A list is sorted
;;;     by may-precede? if 
;;;       (may-precede? (list-ref lst i) (list-ref lst (+ 1 i)))
;;;     for all reasonable i.
;;; Postconditions:
;;;   The result list is sorted by may-precede? (see above for def'n).
;;;   sorted is a permutation of (append sorted1 sorted2).
;;;   Does not affect sorted1 or sorted2.
;;;   sorted may share cons cells with sorted1 or sorted2.
(define$ merge
  (lambda (sorted1 sorted2 may-precede?)
    (cond
      ((null? sorted1) sorted2)
      ((null? sorted2) sorted1)
      ((may-precede? (car sorted1) (car sorted2))
       (cons (car sorted1) 
             (merge (cdr sorted1) sorted2 may-precede?)))
      (else
       (cons (car sorted2) 
             (merge sorted1 (cdr sorted2) may-precede?))))))

;;; Procedure:
;;;   split
;;; Parameters:
;;;   lst, a list
;;; Purpose:
;;;   Split a list into two nearly-equal halves.
;;; Produces:
;;;   (firsthalf secondhalf), a list of two lists.
;;; Preconditions:
;;;   lst is a list.
;;; Postconditions:
;;;   (append firsthalf secondhalf) is a permutation of lst.  That is,
;;;     each element of lst appears in either firsthalf or secondhalf
;;;     and every element of firsthalf or secondhalf appears in lst.
;;;   Does not modify lst.
;;;   Either firsthalf or secondhalf may share cons cells with lst.
(define$ split
  (lambda (lst)
    (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))))))


; +-----------+-------------------------------------------------------
; | Quicksort |
; +-----------+

;;; Procedure:
;;;   Quicksort
;;; Parameters:
;;;   stuff, a list to sort
;;;   precedes?, a binary predicate that compares values.
;;; Purpose:
;;;   Sort stuff.
;;; Produces:
;;;   sorted-stuff, a sorted list
;;; Preconditions:
;;;   precedes? can be applied to any two elements of stuff.
;;;   precedes? is transitive and reflexive.
;;; Postconditions:
;;;   sorted-stuff is a permutation of stuff.
;;;   sorted-stuff is sorted.  That is, 
;;;     (not (precedes? (list-ref sorted-stuff (+ i 1))
;;;                     (list-ref sorted-stuff i)))
;;;     for all reasonable i.
;;;   Does not affect stuff.
(define$ Quicksort
  (lambda (lst precedes?)
;    (display "Sorting: ")
;    (display lst)
;    (newline)
    (if (or (null? lst) (null? (cdr lst)))
        lst
        (let* ((pivot (random-element lst))
               (parts (partition lst pivot precedes?)))
;          (display "  Pivot: ")
;          (display pivot)
;          (newline)
;          (display "  Parts: ")
;          (display parts)
;          (newline)
          (append (Quicksort (car parts) precedes?)
                  (cadr parts)
                  (Quicksort (caddr parts) precedes?))))))

;;; Procedure:
;;;   partition
;;; Parameters:
;;;   lst, a list
;;;   pivot, a value
;;;   precedes?, a binary predicate
;;; Purpose:
;;;   Partition lst into three lists,
;;;    one for which (precedes? val pivot) holds,
;;;    one for which (precedes? pivot val) holds, and
;;;    one for which neither holds.
;;; Produces:
;;;   (smaller-elements equal-elements larger-elements), A two element list
;;; Preconditions:
;;;   precedes? can be applied to pivot and any value of lst.
;;; Postconditions:
;;;   (append smaller-elements equal-elements larger-elements)
;;;     is a permutation of lst.
;;;   (precedes? (list-ref smaller-elements i) pivot)
;;;     holds for every i, 0 < i < (length smaller-elements).
;;;   (precedes? pivot (list-ref larger-elements j))
;;;     holds for every j, 0 < j < (length larger-elements).
(define$ partition       
  (lambda (lst pivot precedes?)
    (letrec ((kernel
              (lambda (remaining smaller-elements equal-elements larger-elements)
                (cond 
                  ((null? remaining)
                   (list smaller-elements equal-elements larger-elements))
                  ((precedes? (car remaining) pivot)
                   (kernel (cdr remaining)
                           (cons (car remaining) smaller-elements)
                           equal-elements
                           larger-elements)) 
                  ((precedes? pivot (car remaining))
                   (kernel (cdr remaining)
                           smaller-elements
                           equal-elements
                           (cons (car remaining) larger-elements)))
                  (else
                   (kernel (cdr remaining)
                           smaller-elements
                           (cons (car remaining) equal-elements)
                           larger-elements))))))
      (kernel lst null null null))))

; +---------+---------------------------------------------------------
; | History |
; +---------+

; Monday, 13 November 2006 (v 0.1) [Samuel A. Rebelsky]
; * Created.