#lang scheme

#|  permutations-test.ss: SchemeUnit test suite for permutations.ss.
    Copyright (C) 2008 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 3 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, see <http://www.gnu.org/licenses/>.
|# 

(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
         "permutations.ss"
         (lib "42.ss" "srfi")
         (only-in (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
    ":permutations generates permutations in lexical order."
    (let ((ps (for/list ((p (in-permutations 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))))))))