finger exercises with binary trees in scheme.

trees.rkt

#lang racket/base

(require racket/list)

(struct node (val left right) #:transparent)

(define (tree-new val) (node val null null))
(define (tree-insert t val)
  (cond [(null? t) (tree-new val)]
        [(null? (node-val t)) (tree-new val)]
        [(<= val (node-val t)) (node (node-val t) (tree-insert (node-left t) val) (node-right t))]
        [else (node (node-val t) (node-left t) (tree-insert (node-right t) val))]))

(define (tree-depth t)
  (cond [(null? t) 0]
        [else (+ 1 (max (tree-depth (node-left t)) (tree-depth (node-right t))))]))

(define (tree-balanced? t)
  (let ([left-depth (tree-depth (node-left t))]
        [right-depth (tree-depth (node-right t))])
    (< (abs (- left-depth right-depth)) 2)))

(define (tree-contains? t val)
  (cond [(null? t) #f]
        [(equal? val (node-val t)) #t]
        [(< val (node-val t)) (tree-contains? (node-left t) val)]
        [else (tree-contains? (node-right t) val)]))

(define (rotate-clockwise n)
  (cond [(null? n) null]
        [else (let* ([left (node-left n)]
                     [left-val (if (null? left) null (node-val left))]
                     [right (node-right n)]

                     [left-right (if (null? left) null (node-right left))]
                     [left-left (if (null? left) null (node-left left))]
         
                     [new-right (node (node-val n) left-right right)])
                (node left-val left-left new-right))]))

(define (rotate-counterclockwise n)
  (cond [(null? n) null]
        [else (let* ([right (node-right n)]
                     [right-val (if (null? right) null (node-val right))]
                     [left (node-left n)]

                     [right-left (if (null? right) null (node-left right))]
                     [right-right (if (null? right) null (node-right right))]

                     [new-left (node (node-val n) left right-left)])
                (node right-val new-left right-right))]))

(define (balance-tree t)
  (cond [(null? t) null]
        [(tree-balanced? t) t]
        ;; right side is deeper; rotate counter-clockwise
        [(< (tree-depth (node-left t)) (tree-depth (node-right t)))
         (balance-tree (rotate-counterclockwise (node (node-val t)
                                                      (balance-tree (node-left t))
                                                      (balance-tree (node-right t)))))]
        [else (balance-tree (rotate-clockwise (node (node-val t)
                                                    (balance-tree (node-left t))
                                                    (balance-tree (node-right t)))))]))

(define (print-in-order t)
  (cond [(null? t) "<NIL>"]
        [else (format "( ~a ) - ( ~a ) - ( ~a )"
                      (print-in-order (node-left t))
                      (node-val t)
                      (print-in-order (node-right t)))]))

(define (tree-fill vals)
  (balance-tree
   (foldl (lambda (e a) (tree-insert a e)) (tree-new null) vals)))