;;; tests/run.scm

(require-library skiplists dbc simple-tests)
(import chicken skiplists dbc simple-tests)

(contract-check-level 2)

(run-tests
  "A NUMERICAL SKIPLIST WITH DUPS"
  (define sls (skiplist 2 integer? -))
  (skiplist? sls)
  (not (skiplist? '(1 2 3)))
  (skiplist-null? sls)
  (not (skiplist-dups? sls))
  (eq? (skiplist-item? sls) integer?)
  (= (skiplist-width sls) 2)
  "INSERT RANDOM VALUES ..."
  (define lst
    (let loop ((k 0) (lst '()))
      (if (= k 100)
        lst
        (loop (+ k 1) (cons (random 100) lst)))))
  (apply skiplist-insert! sls lst)
  (apply < (skiplist->list sls))
  (<= (skiplist-count sls) 100)
  "FILTER ..."
  ((list-of? even?) (skiplist->list (skiplist-filter sls even?)))
  "MAP ..."
  (let ((fn (lambda (x) (* 2 x))))
    (equal?
      (map fn (skiplist->list sls))
      (skiplist->list (skiplist-map sls fn))))
  "INSERT AT BOTH ENDS ..."
  (skiplist-insert! sls -1 100)
  (equal? (skiplist-min sls) '(-1))
  (equal? (skiplist-max sls) '(100))
  (skiplist-search! sls -1)
  (equal? (skiplist-found sls) '(-1))
  (skiplist-search! sls 100)
  (equal? (skiplist-found sls) '(100))
  "REMOVE AT LEFT END ..."
  (skiplist-remove! sls -1)
  (null? (skiplist-found sls))
  (skiplist-search! sls -1)
  (null? (skiplist-found sls))
  "INSERT ONE IN THE MIDDLE AND REMOVE IT AGAIN ..."
  (skiplist-insert! sls 25)
  (skiplist-search! sls 25)
  (= 25 (car (skiplist-found sls)))
  (memv 25 (skiplist-found sls))
  (skiplist-remove! sls 25)
  "RESTRUCTURE ..."
  (equal? (skiplist->list sls)
          (skiplist->list (skiplist-restructure sls 4)))
  "REORDER DECREASING WITHOUT DUPS ..."
  (let ((slsr (skiplist-reorder sls (lambda (x y) (- y x)))))
    (apply > (skiplist->list slsr))
    (equal? (skiplist-min sls) (skiplist-max slsr))
    (equal? (skiplist-max sls) (skiplist-min slsr))
    )
  "AND WITH DUPS ..."
  (equal? (reverse
            (skiplist->list
              (skiplist-reorder sls - dups)))
          (skiplist->list
            (skiplist-reorder sls (lambda (x y) (- y x)) dups)))
  "CLEAR ..."
  (skiplist-clear! sls)
  (null? (skiplist-min sls))
  (null? (skiplist-max sls))
  (skiplist-null? sls)
;)
;
;(run-tests
  "A SKIPLIST OF INTEGER LISTS WITH PRIMARY AND SECONDARY ORDERS"
  (define item-type (lambda (x)
                     (and ((list-of? integer?) x) (> (length x) 2))))
  (define primary-order (lambda (x y) (- (car x) (car y))))
  (define secondary-order (lambda (x y) (- (cadr x) (cadr y))))
  (define sls3 (skiplist 3
                         item-type
                         primary-order
                         secondary-order
                         dups))
  (define lst1
            (let loop ((k 0) (lst '()))
              (if (= k 100)
                lst
                (loop (+ k 1) (cons (random 10) lst)))))
  (define lst2
            (let loop ((k 0) (lst '()))
              (if (= k 100)
                lst
                (loop (+ k 1) (cons (random 10) lst)))))
  (define lst3
            (let loop ((k 0) (lst '()))
              (if (= k 100)
                lst
                (loop (+ k 1) (cons (random 100) lst)))))
  (apply skiplist-insert! sls3
         (map (lambda (x y z) (list x y z))
              lst1 lst2 lst3)) 
  (skiplist-dups? sls3)
  (= (skiplist-count sls3) 100)
  (= (skiplist-width sls3) 3)
  "INSERTING ITEM AND REMOVING ALL WITH SAME KEY ..."
  ((skiplist-item? sls3) '(1 2 3))
  (skiplist-search! sls3 '(1 2 3))
  (if (skiplist-found? sls3 '(1 2 3))
    (apply skiplist-remove! sls3 (skiplist-found sls3)))
  (skiplist-insert! sls3 '(1 2 3))
  (skiplist-search! sls3 '(1 2 3))
  (member '(1 2 3) (skiplist-found sls3))
  (apply skiplist-remove! sls3 (skiplist-found sls3))
  (skiplist-search! sls3 '(1 2 3))
  (null? (skiplist-found sls3))
  "PRODUCE DUPLICATES AT THE ENDS ..."
  (skiplist-insert! sls3 '(-1 2 3) '(-1 2 3 4)) 
  (equal? (skiplist-min sls3) '((-1 2 3 4) (-1 2 3)))
  (skiplist-insert! sls3 '(10 1 2) '(10 1 2 3) '(10 1 3))
  (equal? (skiplist-found sls3) '((10 1 3) (10 1 2 3) (10 1 2)))
  (equal? (skiplist-max sls3) '((10 1 3) (10 1 2 3) (10 1 2)))
  "AND REMOVE THEM AGAIN ..." 
  (skiplist-search! sls3 '(-1 2 3 4))
  (apply skiplist-remove! sls3 (skiplist-found sls3))
  (skiplist-search! sls3 '(-1 2 3 4))
  (null? (skiplist-found sls3))
  (skiplist-search! sls3 '(10 1 3))
  (apply skiplist-remove! sls3 (skiplist-found sls3))
  (null? (skiplist-found sls3))
  "UNDUP IN THE MIDDLE ..."
  (skiplist-search! sls3 '(2 3 4))
  (if (not (null? (skiplist-found sls3)))
    (apply skiplist-remove! sls3 (skiplist-found sls3)))
  (apply skiplist-insert! sls3 '((2 3 4) (2 3 5) (2 3 6 7)))
  (skiplist-search! sls3 '(2 3 4))
  (equal? (skiplist-found sls3) '((2 3 6 7) (2 3 5) (2 3 4)))
  (skiplist-search! sls3 '(2 3 4))
  (apply skiplist-remove! sls3 (cdr (skiplist-found sls3)))
  (skiplist-search! sls3 '(2 3 4))
  (equal? (skiplist-found sls3) '((2 3 6 7)))
  "UNDUP AT LEFT END ..."
  (skiplist-insert! sls3 '(-1 2 3) '(-1 2 3 4)) 
  (skiplist-search! sls3 '(-1 2 3))
  (apply skiplist-remove! sls3 (cdr (skiplist-found sls3)))
  (skiplist-search! sls3 '(-1 2 3))
  (equal? (skiplist-found sls3) '((-1 2 3 4)))
  "UNDUP AT RIGHT END ..."
  (skiplist-insert! sls3 '(10 1 2) '(10 1 2 3) '(10 1 3))
  (skiplist-search! sls3 '(10 1 2 3))
  (apply skiplist-remove! sls3 (cdr (skiplist-found sls3)))
  (skiplist-search! sls3 '(10 1 2 3))
  (equal? (skiplist-found sls3) '((10 1 3)))
  "REORDER REMOVING ALL DUPS ..."
  (apply <= (map car
                 (skiplist->list
                   (skiplist-reorder sls3 primary-order secondary-order))))
  (<= (skiplist-count (skiplist-reorder sls3 primary-order secondary-order))
      (skiplist-count sls3))
  "REORDER USING ONLY SECONDARY ORDER ..."
  (apply < (map cadr
                (skiplist->list
                  (skiplist-reorder sls3 secondary-order))))
  (>= 10 (skiplist-count
           (skiplist-reorder sls3 secondary-order)))
  "FILTER VALUE ..."
  ((list-of? odd?) (map caddr
                        (skiplist->list
                          (skiplist-filter sls3 (lambda (x) (odd? (caddr x)))))))
  )