;;; tests/run.scm

(import scheme
        (chicken base)
        (chicken fixnum)
        (chicken random)
        ;%skiplists
        skiplists
        simple-tests)

(define-test (skiplist-test)
  "SOME DEFINITIONS"
  (set! sls2 (skiplist 4 20 fixnum? - dups))
  (set! sls1 (skiplist 15 fixnum? -))
  (set! sls (skiplist integer? -))
  (set! lst
    (let loop ((k 0) (lst '()))
      (if (= k 100)
        lst
        (loop (+ k 1) (cons (pseudo-random-integer 100) lst)))))
  (set! item-type (lambda (x)
                     (and ((list-of? integer?) x) (> (length x) 2))))
  (set! primary-order (lambda (x y) (- (car x) (car y))))
  (set! secondary-order (lambda (x y) (- (cadr x) (cadr y))))
  (set! sls3 (skiplist 3
                         10
                         item-type
                         primary-order
                         secondary-order
                         dups))
  (set! lst1
    (let loop ((k 0) (lst '()))
      (if (= k 100)
        lst
        (loop (+ k 1) (cons (pseudo-random-integer 10) lst)))))
  (set! lst2
    (let loop ((k 0) (lst '()))
      (if (= k 100)
        lst
        (loop (+ k 1) (cons (pseudo-random-integer 10) lst)))))
  (set! lst3
    (let loop ((k 0) (lst '()))
      (if (= k 100)
        lst
        (loop (+ k 1) (cons (pseudo-random-integer 100) lst)))))

  "SOME CONSTRUCTORS"
  '(define sls2 (skiplist 4 20 fixnum? - dups))
  (fx= (sl-width sls2) 4)
  (fx= (sl-max-height sls2) 20)
  (sl-dups? sls2)
  '(define sls1 (skiplist 15 fixnum? -))
  (fx= (sl-width sls1) 2)
  (fx= (sl-max-height sls1) 15)
  (not (sl-dups? sls1))
  "A NUMERICAL SKIPLIST WITHOUT DUPS"
  '(define sls (skiplist integer? -))
  (skiplist? sls)
  (not (skiplist? '(1 2 3)))
  (sl-null? sls)
  (not (sl-dups? sls))
  (eq? (sl-item? sls) integer?)
  (fx= (sl-max-height sls) 10)
  (fx= (sl-width sls) 2)
  "INSERT RANDOM VALUES ..."
  '(define lst
     (let loop ((k 0) (lst '()))
       (if (= k 100)
         lst
         (loop (+ k 1) (cons (pseudo-random-integer 100) lst)))))
  (apply sl-insert! sls lst)

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