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

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

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

(define min-key 1) 
(define max-key 1000)

(define (key-compare x y) (- x y))

(define ephemeral-map (make-ephemeral-map key-compare))
	   
(define (new-persistent-map) (make-persistent-map key-compare))

;; a hard-wired association between a key and a value"   
(define compute-assoc (lambda (key) (cons key (++ key))))


(test-group "map union"


	    (let* ((compute-assoc1 (lambda (key) (cons key (* 10 key))))
		   
		   (m1
		    (let recur  ((m (new-persistent-map)) (i min-key))
		      (let ((m1 ((m 'put) i (cdr (compute-assoc1 i)))))
			(if (< i max-key) (recur m1 (++ i)) m1))))
		   
		   (compute-assoc2 (lambda (key) (cons key (* 20 key))))
		   
		   (m2
		    (let recur  ((m (new-persistent-map)) (i min-key))
		      (let ((m1 ((m 'put) i (cdr (compute-assoc2 i)))))
			(if (< i max-key) (recur m1 (++ i)) m1))))
		   
		   (m12 (ephemeral-map-operations ((union-with list) m1 m2))))
	      
	      (let recur  ((i min-key))
		(test (sprintf "get element ~A" i) 
		      (list i (cdr (compute-assoc1 i)) (cdr (compute-assoc2 i)))
		      ((m12 'get) i) )
		(if (< i max-key) (recur (++ i))))
		  
	      ))


(test-group "ephemeral map"

  (test-group "verify the map is empty"

	    (test-assert (ephemeral-map 'empty?))
	    (test-assert (zero? (ephemeral-map 'size))))

  (test-group  (sprintf "loading a sequence [~A,~A] in ascending order" min-key max-key)

    (do ((i min-key (++ i))) ((> i max-key))
      (test-assert (sprintf "put element ~A" i) (not ((ephemeral-map 'put!) i (cdr (compute-assoc i)))))
      (test (sprintf "get element ~A" i) (compute-assoc i) ((ephemeral-map 'get) i) ))

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

  (test-group "reloading the same sequence in descending order and then deleting" 
	   
    (test-assert (ephemeral-map 'empty?))
    (test-assert (zero? (ephemeral-map 'size)))
	   
    (do ((i max-key (-- i))) ((< i min-key))
      (test-assert (sprintf "put element ~A" i) (not ((ephemeral-map 'put!) i (cdr (compute-assoc i)))))
      (test (sprintf "get element ~A" i) (compute-assoc i) ((ephemeral-map 'get) i))
      (test-assert (sprintf "delete element ~A" i) ((ephemeral-map 'delete!) i))))

  (test-group "loading the ephemeral-map again in a \"random\" order" 

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

  (test "using fold to sum the elements in the ephemeral-map"  
	(* 500 (+ (+ 1 min-key) (+ 1 max-key)))
	((ephemeral-map '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 ((ephemeral-map-x10 ((ephemeral-map 'map) (lambda (x) (* x 10))))
		    (compute-assoc-x10 (lambda (key) (cons key (* 10 (++ key))))))
		(do ((i min-key (++ i))) ((> i max-key))
		  (test (sprintf "element ~A" i) 
			(compute-assoc-x10 i) 
			((ephemeral-map-x10 'get) i) ))))
  )
	   
(test-group "persistent map"

  (test-group "the empty and size predicates on an empty map"

   (let ((m (new-persistent-map)))
     (test-assert (m 'empty?))
     (test-assert (zero? (m 'size)))))

  (test-group (sprintf "loading a sequence [~A,~A] in ascending order" min-key max-key)

	      (let ((m
		     (let recur  ((m (new-persistent-map)) (i min-key))
		       (let ((m1 ((m 'put) i (cdr (compute-assoc i)))))
			 (test (sprintf "get element ~A" i) (compute-assoc i) ((m1 'get) i))
			 (if (< i max-key) (recur m1 (++ i)) m1)))))
		
		(test (++ (- max-key min-key)) (m 'size))
		(test-assert (not (m 'empty?)))
		
		(test (compute-assoc (++ min-key)) ((m 'get) (++ min-key)) )
		(test (compute-assoc (++ min-key)) ((m 'get) (++ min-key) #f)  )
		
		(test-assert "looking up of non-existing keys" 
			     (not ((m 'get) (-- min-key) #f)))
     ))

  (test-group "reloading the same sequence in descending order and then deleting" 
	      
	      (let ((m
		     (let recur  ((m (new-persistent-map)) (i max-key))
		       (let ((m1 ((m 'put) i (cdr (compute-assoc i)))))
			 (test (sprintf "get element ~A" i) (compute-assoc i) ((m1 'get) i))
			 (let ((m2 ((m1 'delete) i)))
			   (if (< min-key i) (recur m2 (- i)) m2))))))

		(test-assert (zero? (m 'size)))))


  (test-group "fold and map"
	      (let ((m
		     (let recur  ((m (new-persistent-map)) (i min-key))
		       (let ((m1 ((m 'put) i (cdr (compute-assoc i)))))
			 (if (< i max-key) (recur m1 (++ i)) m1)))))

		(test "using fold to sum the elements in the persistent-map"  
		 (* 500 (+ (+ 1 min-key) (+ 1 max-key)))
		 ((m 'fold) (lambda (x sum) (+ x sum)) 0))

		(test-group "using map to multiply each elements by 10"
			    (let ((m-x10 ((m 'map) (lambda (x) (* x 10))))
				  (compute-assoc-x10 (lambda (key) (cons key (* 10 (++ key))))))
			      (do ((i min-key (++ i))) ((> i max-key))
				(test (sprintf "element ~A" i)
				 (compute-assoc-x10 i) 
				 ((m-x10 'get) i) ))))))
)