;; TREE CONSTRUCTOR

(define (tree v l r)
  (if (and (tree? l)
		   (tree? r))
	  (list 'tree v l r)))

;;;; possible alternative definition
;; (define (tree v l r)
;;   (lambda (q)
;; 	(case q
;; 	  (('istree) #t)
;; 	  (('right) r)
;; 	  (('left) l)
;; 	  (('value) v))))

(define (leaf v) (tree v '() '()))

;; TREE PREDICATES

(define (tree? t)
  (or (null? t)
	  (and (list? t)
		   (= (length t) 4)
		   (eq? (car t) 'tree)
		   (let ((right (cadddr t)))
			 (or (leaf? right)
				 (tree? right)))
		   (let ((left (caddr t)))
			 (or (leaf? left)
				 (tree? left))))))

(define (leaf? t)
  (and (list? t)
	   (= (length t) 4)
	   (eq? (car t) 'tree)
	   (null? (cadddr t))
	   (null? (caddr t))))

;; (leaf? (leaf 'a)) => (tree? (leaf 'a))!

;; ACCESS A TREE

(define (tree-get-val t)
  (if (tree? t)	(cadr t)))

(define (tree-get-left t)
  (cond ((null? t) '())
		((tree? t) (caddr t))))

(define (tree-get-right t)
  (cond ((null? t) '())
		((tree? t) (cadddr t))))

;; OUTPUT A TREE

(define (tree-inorder t)
  (cond ((null? t) '())
		((leaf? t) (list (tree-get-val t)))
		(else (append (tree-inorder (tree-get-left t))
					  (cons (tree-get-val t)
							(tree-inorder (tree-get-right t)))))))

(define (tree-preorder t)
  (cond ((null? t) '())
		((leaf? t) (list (tree-get-val t)))
		(else (cons (tree-get-val t)
					(append (tree-preorder (tree-get-left t))
							(tree-preorder (tree-get-right t)))))))

(define (tree-postorder t)
  (cond ((null? t) '())
		((leaf? t) (list (tree-get-val t)))
		(else (append (append (tree-postorder (tree-get-left t))
							  (tree-postorder (tree-get-right t)))
					  (list (tree-get-val t))))))

;; CATEGORISE A TREE

(define (tree-has-left? t)
  (not (eq? (tree-get-left t) '())))

(define (tree-has-right? t)
  (not (eq? (tree-get-right t) '())))

(define (tree-height t)
  (if (or (null? t) (leaf? t)) 0
	  (1+ (max (tree-height (tree-get-left t))
			   (tree-height (tree-get-right t))))))

(define (tree-eq? a b)
  (or (and (null? a) (null? b))
	  (and (eq? (tree-get-val a)
				(tree-get-val b))
		   (tree-eq? (tree-get-left a)
					 (tree-get-left b))
		   (tree-eq? (tree-get-right a)
					 (tree-get-right b)))))

;; MODIFY A TREE

(define (tree-set-val t v)
  (tree v (tree-get-left t) (tree-get-right t)))

(define (tree-set-left t l)
  (if (tree? l)
	  (tree (tree-get-val t) l (tree-get-right t))))

(define (tree-set-right t r)
  (if (tree? r)
	  (tree (tree-get-val t) (tree-get-left t) r)))

(define (tree-map f t)
  (cond ((null? t) t)
		((tree? t)
		 (let tmap ((node t))
		   (tree (f (tree-get-val node))
				 (tmap (tree-get-left node))
				 (tmap (tree-get-right node)))))))

;; (tree-map abs (search-tree-insert-list '() '(5 4 3 2 6 1 4)))

;; (define (tree-insert-left t v)
;;   (if (tree? t)
;; 	  (let ((new (leaf v)))
;; 		(cond ((and (tree-has-left? t)
;; 					(tree-has-right? t))
;; 			   (tree-set-left (tree-insert-left (tree-get-left t) v)))
;; 			  ((tree-has-left? t) (tree-set-right t new))
;; 			  (else	(tree-set-left t new))))))

;; ALTERNATIVE REPRESENTATION

(define (tree->tree-as-list t)
  (if (or (null? t) (leaf? t)) '()
	  (append (list (tree-get-val t)
					(if (tree-has-left? t)
						(tree-get-val (tree-get-left t))
						#f)
					(if (tree-has-right? t)
						(tree-get-val (tree-get-right t))
						#f))
			  (tree->tree-as-list (tree-get-left t))
			  (tree->tree-as-list (tree-get-right t)))))

;; (tree->tree-as-list (search-tree-insert-list '() '(2 1 3 4)))

;; PRINT TREE [TODO]

;; (define (tree-print tr)
;;   (define (next-char c)
;; 	(integer->char (1+ (char->integer c))))
;;   (define (display-node nd x y rx)
;; 	(display "circle ")
;; 	(display nd)
;; 	(display " at "))
;;   (let* step ((ht (/ (tree-height tr) 2))
;; 			 (rx 0)
;; 			 (ry 0)
;; 			 (prev-lt #\A)
;; 			 (curr-lt (next-char prev-lt)))
;; 	(display "circle ")
;; 	(display curr-lt)
;; 	(display " at ")))

;;;; (BINARY) SEARCH TREE

;; PREDICATES

(define (search-tree? bt)
  (and (tree? bt)
	   (or (null? bt)
		   (leaf? bt)
		   (let ((v (tree-get-val bt))
				 (l (tree-get-left bt))
				 (r (tree-get-right bt)))
			 (and (real? v)
				  (or (null? l)
					  (< (tree-get-val l) v))
				  (or (null? r)
					  (< v (tree-get-val r)))
				  (search-tree? l)
				  (search-tree? r))))))

(define (search-tree-find bt v)
  (if (and (real? v) (search-tree? bt))
	  (let ((val (tree-get-val bt)))
		(cond ((= val v) bt)
			  ((< val v) (search-tree-find (tree-get-right bt) v))
			  ((> val v) (search-tree-find (tree-get-left bt) v))))))

(define (search-tree-contains bt v)
  (tree? (search-tree-find bt v)))

;; (search-tree-contains (tree 3 (tree 1 (leaf 0) (leaf 2)) (leaf 5)) 5) => #t
;; (search-tree-contains (tree 3 (tree 1 (leaf 0) (leaf 2)) (leaf 5)) 6) => #f

(define (search-tree-get-min t)
  (cond ((null? t) '())
		((search-tree? t)
		 (let get-min ((left (tree-get-left t))
					   (parent t))
		   (if (null? left)
			   parent
			   (get-min (tree-get-left left) left))))))

(define (search-tree-get-max t)
  (cond ((null? t) '())
		((search-tree? t)
		 (let get-max ((right (tree-get-right t))
					   (parent t))
		   (if (null? right)
			   parent
			   (get-max (tree-get-right right) right))))))

;; (search-tree-get-min (tree 3 (tree 1 (leaf 0) (leaf 2)) (leaf 5)))

;; OPERATIONS

(define (search-tree-insert bt v)
  (if (null? bt)
	  (leaf v)
	  (if (search-tree? bt)
		  (let ((val (tree-get-val bt)))
			(cond ((= val v) bt)
				  ((< val v)
				   (tree-set-right bt (search-tree-insert (tree-get-right bt) v)))
				  ((> val v)
				   (tree-set-left bt (search-tree-insert (tree-get-left bt) v))))))))

(define (search-tree-insert-list bt vs)
  (if (null? vs) bt
	  (search-tree-insert-list (search-tree-insert bt (car vs))
							   (cdr vs))))

;; (equal? (search-tree-insert (tree 3 (tree 1 (leaf 0) (leaf 2)) (leaf 5)) 4)
;; 		(tree 3 (tree 1 (leaf 0) (leaf 2)) (tree 5 (leaf 4) '())))
;; (search-tree? (search-tree-insert (leaf 3) 2))
;; (search-tree? (search-tree-insert (tree 3 (tree 1 (leaf 0) (leaf 2)) (leaf 5)) 6))
;; (tree-height '(tree 3 (tree 1 (tree 0 () ()) (tree 2 () ())) (tree 5 () ())))
;; (tree-height (search-tree-insert-list '(50) (iota 100)))

;;;; AVL TREES

(define (avl-val at)
  (if (search-tree? at)
	  (- (tree-height (tree-get-right at))
		 (tree-height (tree-get-left at)))))

;; (avl-val (search-tree-insert-list '() '(1 2 3 4 5 6 7 -2 -3 -4 -5 -6 -7)))

(define (avl-tree? at)
  (or (null? at)
	  (and (search-tree? at)
		   (memq (avl-val at) '(-1 0 1))
		   (avl-tree? (tree-get-left at))
		   (avl-tree? (tree-get-right at)))))

(avl-tree? (search-tree-insert-list '() '(3 1 5 4 7 9)))

(map integer->char
	 (tree-preorder (search-tree-insert-list '()
					 (map char->integer
						  (string->list
						   "AuDi$!Fun")))))

(tree-preorder (search-tree-insert-list
				'()
				(tree-postorder (search-tree-insert-list '() '(4 1 2 3 5 6 7 8)))))

(list->string
 (map
  integer->char
  (tree-inorder
   (search-tree-insert-list
	'()
	(map
	 char->integer
	 (string->list
	  "Noot?;)"
	  )
	 )
	)
   )
  )
 )