#|  permutations-test.ss: SchemeUnit test suite for permutations.ss.
Copyright (C) Will M. Farr <farr@mit.edu>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|# 

(module permutations-test mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
           "permutations.ss"
           (lib "42.ss" "srfi")
           (only (lib "43.ss" "srfi") vector-swap!))
  
  (provide permutations-test-suite)
  
  (define vector-<
    (case-lambda
      ((v1 v2)
       (let ((l1 (vector-length v1))
             (l2 (vector-length v2)))
         (cond
           ((< l1 l2) #t)
           ((> l1 l2) #f)
           (else (let loop ((i 0))
                   (cond
                     ((= i l1) #f)
                     ((= (vector-ref v1 i)
                         (vector-ref v2 i))
                      (loop (+ i 1)))
                     (else (< (vector-ref v1 i)
                              (vector-ref v2 i)))))))))
      ((v1 v2 . vs)
       (and (vector-< v1 v2)
            (apply vector-< v2 vs)))))
  
  (define permutations-test-suite
    (test-suite
     "permutations.ss test suite"
     (test-case
      ":permutations generates permutations in lexical order."
      (let ((ps (list-ec (:permutations p 4) p)))
        (check-true (apply vector-< ps))
        (check-true (every?-ec (:list p ps) (permutation? p)))))
     (test-case
      "permutation? works"
      (check-true (permutation? (vector 0 1 2 3 4)))
      (check-false (permutation? (vector 1 2 3 4 5)))
      (check-true (permutation? (vector 2 4 1 3 0)))
      (check-false (permutation? (vector 0 1 2 3 0 5))))
     (test-case
      "pvector-ref and pvector-set! work"
      (let ((p (permutation-next (permutation-next (permutation-identity 4))))
            (id (permutation-identity 4)))
        (check-equal? p (vector-of-length-ec 4 (:range i 4) (pvector-ref p id i)))
        (do-ec (:range i 4)
          (pvector-set! p id i i))
        (check-equal? id p)))
     (test-case
      "signature behaves sensibly"
      (let ((ps (list-ec (:permutations p 5) p)))
        (check-equal? (apply + (map permutation-signature ps)) 0)
        (let* ((p (list-ref ps 15))
               (sig-p (permutation-signature p)))
          (check-equal? (* sig-p -1) (permutation-signature (begin (vector-swap! p 1 3) p)))))))))