guile-data-structures/trees/simple-binary-tree/test-binary-search-tree.scm

(import
 (except (rnrs base) error vector-map)
 (only (guile) lambda* λ error)
 ;; SRFI-64 for unit testing
 (srfi srfi-64)
 (binary-tree))


(test-begin "tree-test")


(test-group "tree-leaf?"
  (test-assert "tree-leaf returns #t for a leaf"
    (tree-leaf? (make-leaf 'something)))

  (test-assert "tree-leaf returns #f for a non-leaf - 01"
    (not (tree-leaf? (make-tree 'something
                                (make-leaf 'something)
                                (make-empty-tree)))))

  (test-assert "tree-leaf returns #f for a non-leaf - 02"
    (not (tree-leaf? (make-tree 'something
                                (make-leaf 'something)
                                (make-leaf 'something))))))


(test-group "tree-member?"
  (test-assert "tree-member? returns #f for non-member"
    (let ([tree (make-tree 5
                           (make-leaf 3)
                           (make-leaf 7))])
      (not (tree-member? tree 4 <))))

  (test-assert "tree-member? returns #t for member at root node"
    (let ([tree (make-tree 5
                           (make-leaf 3)
                           (make-leaf 7))])
      (tree-member? tree 5 <)))

  (test-assert "tree-member? returns #t for member at leaf node left"
    (let ([tree (make-tree 5
                           (make-leaf 3)
                           (make-leaf 7))])
      (tree-member? tree 3 <)))

  (test-assert "tree-member? returns #t for member at leaf node right"
    (let ([tree (make-tree 5
                           (make-leaf 3)
                           (make-leaf 7))])
      (tree-member? tree 7 <)))

  (test-assert "tree-member? returns #f for any value if tree is empty"
    (not (tree-member? (make-empty-tree) 7 <))))


(test-group "tree-insert"
  (test-assert "inserting an element into a tree makes it so that the element is in the tree"
    (tree-member? (tree-insert (make-empty-tree) 7 <) 7 <))

  (test-assert "inserting an element into a tree creates expected structure"
    (equal? (tree-insert (make-empty-tree) 7 <)
            (make-leaf 7)))

  (test-assert "inserting inserts at correct place in tree"
    (equal? (tree-insert (tree-insert (tree-insert (make-empty-tree) 5 <) 7 <) 3 <)
            (make-tree 5
                       (make-leaf 3)
                       (make-leaf 7)))))


(test-group "make-complete-tree"
  (test-assert "make-complete-tree creates a tree of correct depth"
    (= (tree-depth (make-complete-tree "hello!" 2)) 2))

  (test-assert "make-complete-tree creates an empty tree for depth 0"
    (= (tree-depth (make-complete-tree "foo" 0)) 0))

  (test-assert "make-complete-tree creates a tree filled with the correct elements"
    (let ([elem 'myelem])
      (let iter ([tree° (make-complete-tree elem 3)])
        (cond
         [(tree-empty? tree°) #t]
         [(eq? (tree-value tree°) elem)
          (and (iter (tree-left tree°))
               (iter (tree-right tree°)))]
         [else #f]))))

  (test-assert "make-complete-tree creates a full binary tree"
    (let ([depth 2])
      (let iter ([tree° (make-complete-tree 'foo depth)]
                 [depth° depth])
        (cond
         [(and (tree-empty? tree°) (= depth° 0)) #t]
         [else
          (cond
           [(tree-empty? tree°) #f]
           [else
            (and (iter (tree-left tree°) (- depth° 1))
                 (iter (tree-right tree°) (- depth° 1)))])])))))


(test-group "tree-depth"
  (test-assert "tree-depth gives zero for empty tree"
    (= (tree-depth (make-empty-tree))
       0))

  (test-assert "tree-depth gives correct depth - 01"
    (= (tree-depth
        (make-tree 1
                   (make-tree 1
                              (make-leaf 1)
                              (make-leaf 1))
                   (make-tree 1
                              (make-leaf 1)
                              (make-leaf 1))))
       3))

  (test-assert "tree-depth gives correct depth - 02"
    (= (tree-depth (make-leaf 1))
       1)))


(test-group "tree-size"
  (test-assert "tree-size gives correct result for empty tree"
    (= (tree-size (make-empty-tree))
       0))

  (test-assert "tree-size gives correct result for non-empty tree"
    (= (tree-size
        (make-tree 1
                   (make-tree 2
                              (make-leaf 4)
                              (make-leaf 5))
                   (make-tree 3
                              (make-leaf 6)
                              (make-leaf 7))))
       7))

  (test-assert "tree-size gives correct result for heavily unbalanced tree"
    (= (tree-size
        (make-tree
         1
         (make-tree
          2
          (make-tree
           3
           (make-leaf 4)
           (make-empty-tree))
          (make-empty-tree))
         (make-empty-tree)))
       4)))


(test-group "tree-fold"
  (test-assert "tree-fold gives correct result for empty tree - 01"
    (eq? (tree-fold (λ (val acc) (or val acc))
                    'blub
                    (make-empty-tree))
         'blub))

  (test-assert "tree-fold gives correct result for empty tree - 02"
    (eq? (tree-fold (λ (val acc) (or val acc))
                    #f
                    (make-empty-tree))
         #f))

  (test-assert "tree-fold gives correct result for empty tree - 03"
    (eq? (tree-fold (λ (val acc) (and val acc))
                    #t
                    (make-empty-tree))
         #t))

  (test-assert "tree-fold gives correct result for non-empty tree - 01"
    (= (tree-fold (λ (val acc) (+ val acc))
                  0
                  (make-tree 1
                             (make-tree 1
                                        (make-tree 1
                                                   (make-leaf 1)
                                                   (make-leaf 1))
                                        (make-tree 1
                                                   (make-leaf 1)
                                                   (make-leaf 1)))
                             (make-leaf 1)))
       9))

  (test-assert "tree-fold gives correct result for non-empty tree - 02"
    (= (tree-fold +
                  0
                  (make-tree 5
                             (make-tree -3
                                        (make-tree 3
                                                   (make-leaf 9)
                                                   (make-leaf -6))
                                        (make-tree 1
                                                   (make-leaf 0)
                                                   (make-leaf 1)))
                             (make-leaf 0)))
       10)))


(test-group "make-balanced-tree"
  (test-assert "make-balanced-tree creates an empty tree for size 0"
    (equal? (make-balanced-tree 'something 0)
            (make-empty-tree)))

  (test-assert "make-balanced-tree creates tree of correct size - 01"
    (= (tree-size (make-balanced-tree 'something 5))
       5))

  (test-assert "make-balanced-tree creates tree of correct size - 02"
    (= (tree-size (make-balanced-tree 'something 100))
       100))

  (test-assert "make-balanced-tree creates tree of correct depth - 01"
    (= (tree-depth (make-balanced-tree 'something 8))
       4))

  (test-assert "make-balanced-tree creates tree of correct depth - 02"
    (= (tree-depth (make-balanced-tree 'something 1))
       1))

  (test-assert "make-balanced-tree creates a tree filled with only the filling"
    (let ([val 'something])
      (tree-fold (λ (elem acc)
                   (and (eq? elem val) acc))
                 val
                 (make-balanced-tree val 10)))))


(test-end "tree-test")