;;
;; Verifying the rb-tree package
;;

(require-library srfi-1 srfi-13 rb-tree test)
(import srfi-1 srfi-13 rb-tree test)

(define (++ x) (fx+ 1 x))
(define (-- x) (fx- x 1))

(define min-key 1) 
(define max-key 100)
	   
(define rb-tree (make-rb-tree (lambda (x y) (- x y))))
	
;; a hard-wired association between a key and a value"   
(define compute-assoc (lambda (key) (cons key (++ key))))
	   
(test-group "rb-tree-test initial"

	    (test-assert (rb-tree 'empty?))
	    (test-assert (zero? (rb-tree 'size))))

(test-group (string-concatenate (list "loading a sequence [" 
				      (number->string min-key) ", " 
				      (number->string max-key) "] in ascending order"))

    (do ((i min-key (++ i))) ((> i max-key))
      (test-assert (not ((rb-tree 'put!) i (cdr (compute-assoc i)))))
      (test (compute-assoc i)((rb-tree 'get) i) ))

     (test (rb-tree 'size) (++ (- max-key min-key)))
     (test-assert (not (rb-tree 'empty?)))
	   
     (test (compute-assoc (++ min-key)) ((rb-tree 'get) (++ min-key)) )
     (test (compute-assoc (++ min-key)) ((rb-tree 'get) (++ min-key) #f)  )
	   
     (test-assert "check looking up of non-existing keys" 
		  (not ((rb-tree 'get) (-- min-key) #f)))
	   
     (rb-tree 'clear!)
     )

(test-group "reloading the same seq in descending order and then deleting" 
	   
    (test-assert (rb-tree 'empty?))
    (test-assert (zero? (rb-tree 'size)))
	   
    (do ((i max-key (-- i))) ((< i min-key))
      (test-assert (not ((rb-tree 'put!) i (cdr (compute-assoc i)))))
      (test  (compute-assoc i) ((rb-tree 'get) i))
      (test-assert ((rb-tree 'delete!) i))))

(test-group "loading the rb-tree again in a \"random\" order" 

     (test-assert (zero? (rb-tree 'size)))
	   
     (do ((i min-key) (j max-key) (direction #t (not direction)))
	 ((< j i))
       (cond
	(direction
	 (test-assert (not ((rb-tree 'put!) i (cdr (compute-assoc i)))))
	 (set! i (++ i)))
	(else
	 (test-assert (not ((rb-tree 'put!) j (cdr (compute-assoc j)))))
	 (set! j (-- j))))))
    
(test-group "looking up the elements in  the rb-tree" 
    (do ((i min-key (++ i))) ((> i max-key))
 	    (test (compute-assoc i) ((rb-tree 'get) i) )))

(test "using fold to sum the elements in the rb-tree"  
      (* 50 (+ (+ 1 min-key) (+ 1 max-key)))
      ((rb-tree 'fold) (lambda (x sum) (+ x sum)) 0))

(test-group "using 'map to create a copy of tree with each element x mapped to x*10"
    (let ((rb-tree-x10 ((rb-tree 'map) (lambda (x) (* x 10))))
 	  (compute-assoc-x10 (lambda (key) (cons key (* 10 (++ key))))))
      (do ((i min-key (++ i))) ((> i max-key))
	(test (compute-assoc-x10 i) ((rb-tree-x10 'get) i) ))))