;;; File:
;;;   quicksort.ss
;;; Author:
;;;   Samuel A. Rebelsky
;;; Summary:
;;;   Procedures for sorting stuff using the legendary Quicksort procedure.
;;; Version:
;;;   1.3 of February 2003
;;; Contents:
;;;   Primary Procedures:
;;;     (quicksort lst comes-before? same?)
;;;       Sort a list using a variant of the Quicksort procedure.
;;;     (quicksort! vec may-precede?)
;;;       Sort a vector in place using a variant of the Quicksort procedure.
;;;   Primary Helpers:
;;;     (select pred? lst)
;;;       Select all elements of lst for which pred? holds.
;;;     (select-pivot lst)
;;;       Select an unpredictable element of lst.
;;;   Utility Procedures:
;;;     (random-list max len)
;;;       Generate a list of length len whose elements are all
;;;       between 0 and max, inclusive.
;;;   Standard Higher-Order Procedures:
;;;     (left-section binproc left)
;;;     (right-section binproc right)
;;; History
;;;   Thursday, 27 February 2003 [v 1.0]
;;;     Created.

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

;;; Procedure:
;;;   quicksort
;;; Parameters:
;;;   lst, a list to sort
;;;   comes-before?, a binary predicate that compares values.
;;;   same?, a binary predicate that compares values.
;;; Purpose:
;;;   Sort stuff.
;;; Produces:
;;;   sorted-stuff, a sorted list
;;; Preconditions:
;;;   comes-before? can be applied to any two elements of stuff.
;;;   comes-before? represents a transitive operation.
;;;   same? can be applied to any two elements of stuff.
;;;   For any two values, a and b, exactly one of the following holds:
;;;    1. (comes-before? a b)
;;;    2. (same? a b)
;;;    3. (comes-before? b a)
;;; Postconditions:
;;;   sorted-stuff is sorted.  That is, any element may precede the 
;;;     subsequent element.  In Scheme, we'd say that
;;;       ((disjunction comes-before? same?) (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.
;;; Examples:
;;;   To sort values, a list of numbers, in increasing order.
;;;     (quicksort values < =)
;;;   To sort values, a list of numbers, in decreasing order.
;;;     (quicksort values > =)
;;;   To sort people, a list of (last-name first-name phone-number)
;;;     triplets, by first name
;;;     (quicksort people 
;;;                (lambda (person1 person2) 
;;;                  (string<? (cadr person1) (cadr person2)))
;;;                (lambda (person1 person2) 
;;;                  (string=? (cadr person1) (cadr person2))))
(define quicksort
  (lambda (lst comes-before? same?)
    ; (display "Sorting: ") (display lst) (newline)
    ; If there are only zero or one elements in the list,
    ; the list is already sorted.
    (if (or (null? lst) (null? (cdr lst)))
        lst
        ; Otherwise, 
        ;   Identify a pivot.
        ;   Build three lists (smaller, same, greater).
        ;   Sort smaller and greater.
        ;   Join the sorted parts.
        (let* ((pivot (select-pivot lst))
               (smaller (select (right-section comes-before? pivot) lst))
               (larger (select (left-section comes-before? pivot) lst))
               (same (select (left-section same? pivot) lst)))
          ; (display "  Same:    ") (display same)    (newline)
          ; (display "  Smaller: ") (display smaller) (newline)
          ; (display "  Larger:  ") (display larger)  (newline)
          (append (quicksort smaller comes-before? same?) 
                  same 
                  (quicksort larger comes-before? same?))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Primary Helpers

;;; Procedure:
;;;   select
;;; Parameters:
;;;   pred?, a unary predicate
;;;   lst, a list
;;; Purpose:
;;;   Select all values of lst for which pred? holds.
;;; Produces:
;;;   selected, a list
;;; Preconditions:
;;;   pred? can be applied to every element of lst.
;;; Postconditions:
;;;   pred? holds for every value in selected.
;;;   Every element in selected is in lst.
;;;   pred? does not hold for every value in lst but not
;;;     in selected.
(define select
  (lambda (pred? lst)
    (cond
      ((null? lst) null)
      ((pred? (car lst)) (cons (car lst) (select pred? (cdr lst))))
      (else (select pred? (cdr lst))))))

;;; Procedure:
;;;   select-pivot
;;; Parameters:
;;;   lst, a list of values
;;; Purpose:
;;;   "Randomly" selects a value from lst.
;;; Produces:
;;;   val, a value
;;; Preconditions:
;;;   lst is nonempty.
;;; Postconditions:
;;;   val is a member of lst.
;;;   It is difficult to predict which member of lst val is.
(define select-pivot
  (lambda (lst)
    (list-ref lst (random (length lst)))))

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

;;; 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))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Standard Higher-Order Procedures

(define left-section
  (lambda (binproc left)
    (lambda (right)
      (binproc left right))))

(define right-section
  (lambda (binproc right)
    (lambda (left)
      (binproc left right))))