;;;;

(import test)

(import (test-utils gloss) (only (chicken format) format))

;;;

(define R1 #(1 2 3 4 5 6 7 8 9))
(define R2 '(1.1 2.2 3.3 4.4 5.5 6.6 7.7 8.8 9.9))

;;;

(test-begin "Sequences Utils")

(import (prefix sequences seq:))
;(import (prefix (sequences utils) seq:))
(import (srfi 1))

;;

(import (prefix (sequences utils misc) seq:))

(test-group "reduce"
  (test 0 (seq:reduce + 0 #()))
  (test 5 (seq:reduce + 0 #(5 -4 1 3)))
)

(test-group "coercion"
  (test '(#\a #\b) (seq:->list "ab"))
  (test #(#\a #\b) (seq:->vector "ab"))
  (test "ab" (seq:->string '(#\a #\b)))
)

(test-group "foldl->alist"
  (test '() (seq:foldl->alist '() (lambda (v i) (cons i v)) '()))
  (test '((b b) (a a a)) (seq:foldl->alist '(a b a) (lambda (i v) (cons v i)) '()))
)

;;

(import (prefix (sequences utils sort) seq:))

(test-group "sort"
  (define V1 #(5 3 4 2 1 9 7 8 6))
  (test "Performs Sort" R1 (seq:sort V1 <))
  (test-assert "And Source is Unsorted" (not (seq:sorted? V1 <)))
  (test "Performs Sort!" R1 (seq:sort! V1 <))
  (test-assert "And Source is Sorted" (seq:sorted? V1 <))
)

;sort was side-effecting a list arg
(test-group "sort bug"
  (define R1L '(1 2 3 4 5 6 7 8 9))
  (define V1L '(5 3 4 2 1 9 7 8 6))
  (test "Performs Sort" R1L (seq:sort V1L <))
  (test-assert "And Source is Unsorted" (not (seq:sorted? V1L <)))
  (test "Performs Sort!" R1L (seq:sort! V1L <))
  (test-assert "And Source is Sorted" (seq:sorted? V1L <))
)

(test-group "merge"
  (define RV #(1 1.1 2 2.2 3 3.3 4 4.4 5 5.5 6 6.6 7 7.7 8 8.8 9 9.9))
  (define RS '(1 2 3 4 5 6 7 8 9))
  (define R2x '(1.1 2.2 3.3 4.4 5.5 6.6 7.7 8.8 9.9))
  (test "Merges into same type" RV (seq:merge R1 R2 <))
  ;must copy R2 since destructive, but only defined on lists so vector ok
  (test "Merges into same type" RV (seq:merge! R1 (append R2 '()) <))
  ;must copy R2 since destructive, but only defined on lists so vector ok
  (test "Merges into same list" RS (seq:merge! RS (append R2 '()) <))
)

(test-group "unique"
  (test "abcdefg" (seq:unique "aaaabcccdeffffg" char=?))
  (test #(1 2 3) (seq:unique #(1 2 2 2 3 3)))
  (test #(1 2 3) (seq:sort (seq:unique/unsorted #(2 3 1 3 2 1)) <))
)

;;

(import (prefix (sequences utils sample) seq:))

(test-group "histogram"
  (test '() (seq:histogram ""))
  (test '((#\a . 7)) (seq:histogram "aaaaaaa"))
  (test '((#\space . 1) (#\p . 2) (#\h . 1) (#\o . 3) (#\s . 4) (#\f . 2) (#\; . 2)
          (#\q . 1) (#\j . 6) (#\l . 2) (#\e . 3) (#\i . 1) (#\w . 3) (#\k . 5) (#\d . 2)
          (#\c . 3) (#\b . 1) (#\a . 7))
        (seq:histogram "abcccdkwiweklajakjq;jkkladfsjaso;hasejfopasjeopw "))
  (test '() (seq:histogram '()))
  (test '((a . 7)) (seq:histogram '(a a a a a a a)))
)

(test-group "random"
  (define RV #(1 1.1 2 2.2 3 3.3 4 4.4 5 5.5 6 6.6 7 7.7 8 8.8 9 9.9))
  (define RS '(0 1 2 3 4 5 6 7 8 9))

  (test-group "random lists"
    ;just the list-of random-integers
    (let ((rs (seq:random-integers RS)))
      (test-assert (list? rs))
      (test 30 (seq:size rs))
      (test-assert (seq:all? integer? rs)) )
    (let ((rs (seq:random-reals RV)))
      (test-assert (vector? rs))
      (test 30 (seq:size rs))
      (test-assert (seq:all? inexact? rs)) )
  )

  (test-group "random sample"
    ;vector & string randoms
    (let ((ss (seq:random-sample RS 5)))
      ;(gloss ss)
      (test-assert (list? ss))
      (test 5 (seq:size ss))
      (test-assert (seq:all? fixnum? ss)) )
    (let ((ss (seq:random-sample RV 5)))
      ;(gloss ss)
      (test-assert (vector? ss))
      (test 5 (seq:size ss))
      (test-assert (seq:all? number? ss)) )
    (let ((ss (seq:random-sample "akldkewaklawefnfvlwefklr" 7)))
      ;(gloss ss)
      (test-assert (string? ss))
      (test 7 (seq:size ss))
      (test-assert (seq:all? char? ss)) )
    ;length could be < requested (5)
    (let ((ss (seq:random-sample RV 5 (seq:size RV) 0 #t)))
      ;(gloss ss)
      (test-assert (vector? ss))
      (test-assert (>= 5 (seq:size ss)))
      (test-assert (seq:all? number? ss)) )
  )

  (test-group "cyclic sample"
    (let ((ss (seq:cyclic-sample RS 2)))
      ;(gloss ss)
      ;(test-assert (list? ss))
      ;(test 5 (seq:size ss))
      ;(test-assert (seq:all? number? ss))
      (test '(0 2 4 6 8) (identity ss)) )
  )
)

(test-end "Sequences Utils")

(test-exit)