0. #lang typed/racket
1.  
2. (require typed/rackunit)
3.  
4. (define-type Color (U 'red 'black))
5. (define-type RBTree (U Node 'mt))
6. (struct Node ([color : Color] [l : RBTree] [r : RBTree]) #:transparent)
7.  
8. (define nat? natural?)
9.  
10. ;; given an RBTree, return true if the number of black nodes along every path is the same
11. (define (blackcheck [t : RBTree])
12.   (and (bc/helper t) #t))
13.  
14. ;; given an RBTree where the number of black nodes is the long along every path to an 'mt, return
15. ;; the number of black nodes along those paths. Otherwise, return false
16. (define (bc/helper [t : RBTree]) : (U False Natural)
17.   (match t
18.     ['mt 0]
19.     [(Node color l r)
20.      (define l-result (bc/helper l))
21.      (define r-result (bc/helper r))
22.      (match* (l-result r-result)
23.        [((? nat? l#) (? nat? r#))
24.         (cond [(= l# r#)
25.                (+ (oneifblack color) l#)]
26.               [else #f])]
27.        [(_ _) #f])]))
28.  
29. ;; return 1 if the color is black, 0 if it's red
30. (define (oneifblack [c : Color])
31.   (match c
32.     ['red 0]
33.     ['black 1]))
34.  
35. (check-equal? (blackcheck 'mt) #t)
36. (check-equal? (blackcheck (Node 'black (Node 'black 'mt 'mt) 'mt)) #f)
37. (check-equal? (blackcheck (Node 'black (Node 'black 'mt 'mt) (Node 'black 'mt 'mt))) #t)
38. (check-equal? (blackcheck (Node 'black (Node 'red (Node 'black 'mt 'mt) (Node 'black 'mt 'mt))
39.                                 (Node 'black 'mt 'mt))) #t)
40. (check-equal? (blackcheck (Node 'black (Node 'red (Node 'black 'mt 'mt) 'mt)
41.                                 (Node 'black 'mt 'mt))) #f)

=>