;;; sorttester.ss
;;;   A series of functions that may be helpful in testing sorting
;;;   functions.
;;; Author
;;;   Samuel A. Rebelsky
;;; Version
;;;   1.0 of April 1998
;;; Requires
;;;   utils.ss
;;; Copyright (c) 1998 Samuel A. Rebelsky.  All rights reserved.

;;; Generate a list whose sorting depends on whether the sorting is
;;; textual or numerical.  Numerical computation is based on the
;;; value of each element.  Textual comparison is based on the individual
;;; digits in sequence.  For example, since 1 < 2, a textual comparison
;;; routine will place 11 before 2.
;;;
;;; Note: In order to develop a reasonable list, that list will need
;;;   to be of length at least three.
;;; Note: Since we're only checking a simple kind of comparison, it
;;;   will suffice to generate the list (1 2 11 12 111 112 ...)
;;; Note: It's useful to generate a numerically sorted list (given
;;;   that we'll be using this list to test numerical sorting).
;;; Strategy:
;;;   We'll alternate between adding 1 and 10^x-1.  For example,
;;;   we start with 1.  We add 1 to get 2.  We add 9 (10^1-1) to
;;;   get 11.  We add 1 to get 12.  We add 99 (10^2) to get 111.
;;; Helper:
;;;   Our helper function will keep track of the power-of-ten, the
;;;   next value to generate, and the next increment to add.
(define (weird-list n)
  (weirdlist-helper n 1 1 10))
(define (weirdlist-helper n val inc tens)
  (if (<= n 0)
      nil
      (let ((nextn (- n 1))
            (nextval (+ val inc))
            (nextinc (if (= inc 1) (- tens 1) 1))
            (nexttens (if (= inc 1) (* tens 10) tens)))
        (cons val 
              (weirdlist-helper nextn nextval nextinc nexttens)))))

;;; Generate a list that includes both duplicates and different numbers.
;;; Make it an ordered list so that it's easy to check if we've sorted
;;; it correctly.
;;; Alternate adding 3 and 0 to the last element added.
(define (dupe-and-diff n)
  (letrec ((helper (lambda (n val inc)
              (if (<= n 0) nil
                  (cons val 
                        (helper (- n 1) (+ val inc)
                                (if (= inc 0) 3 0)))))))
     (helper n 1 0)))

;;; Given a sorting function, f, a sorted list, l, and a permutation of 
;;; that list, p, determine if f correctly sorts l.  
(define (sorts-perm? f l p)
  (equal? l (f p)))

;;; Given a sorting function, sortfun, and a sorted list, l, determines 
;;; all permutations of l that the sorting function fails to sort.
;;; If the sorts every function successfully, return nil.
(define (failed-permutations sortfun l)
   (select (lambda (perm) 
              (not (sorts-perm? sortfun l perm))) 
           (permutations l)))

;;; Given a sorting function, sortfun, and a sorted list, l, determine
;;; if sortfun correctly sorts all permutations of l.
(define (sorts-all-permutations? sortfun l)
  (null? (failed-permutations sortfun l)))

;;; Given a sorting function, sort, and a number, n, determine
;;; whether the sorting function seems to sort all lists of size
;;; up to n.
(define (sorts-up-to? sort n)
  (if (<= n 0)
      (equal? nil (sort nil))
      (and
         ;;; Try lists of positive numbers
         (sorts-all-permutations? sort (nints n 1))
         ;;; Try lists of negative and positive numbers
         (sorts-all-permutations? sort 
           (nints n (- 0 (round (/ n 2)))))
         ;;; Try lists of identical numbers
         (sorts-all-permutations? sort (ncopies n 0))
         (sorts-all-permutations? sort (ncopies n 1))
         ;;; Try the weirdo lists that are sorted differently
         ;;; if textual sorting is used
         (sorts-all-permutations? sort (weird-list n))
         ;;; Try our standard list with both duplicate and
         ;;; different elements.
         (sorts-all-permutations? sort (dupe-and-diff n))
         ;;; And recurse
         (sorts-up-to? sort (- n 1)))))

;;; Build a list of lists of up to size n that our function fails to sort.
;;; Certainly not guaranteed to provide all such lists, if there are
;;; some that the function fails to sort, is likely to produce at
;;; least one such list.
;;; (This is a sample function, and is not complete.)
(define (fails-to-sort sortfun n)
  (if (= n 0)
      (failed-permutations sortfun nil)
      (append
         (failed-permutations sortfun (nints n 1))
         (failed-permutations sortfun
                              (nints n (- 0 (round (/ n 2)))))
         (failed-permutations sortfun (ncopies n 1))
         (failed-permutations sortfun (weird-list n))
         (failed-permutations sortfun (dupe-and-diff n))
         (fails-to-sort sortfun (- n 1)))))

;;; See if our sorting function seems to sort lists up to size 8.
(define (sorts? sortfun)
  (sorts-up-to? sortfun 8))