-
Notifications
You must be signed in to change notification settings - Fork 3
/
draw-binary-tree.rkt
162 lines (129 loc) · 4.58 KB
/
draw-binary-tree.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
#lang s-exp rosette
(require racket/gui/base)
(require "../core/wallingford.rkt")
(require "../applications/geothings.rkt")
(define picture (new thing%))
(define frame (new frame%
[label "Binary Tree Example"]
[width 800]
[height 600]))
(define canv (new canvas% [parent frame]
[paint-callback
(lambda (canvas dc)
(send dc set-pen "black" 1 'solid)
(send dc set-brush "black" 'solid)
(showtest))]))
(define dc (send canv get-dc))
(define branch-x-spacing 5) ; Space between adjacent points from separate subtrees
(define branch-x-distrib 20) ; Space between adjacent points in same subtree
(define branch-y-spacing 20) ; Vertical space of a single tree "row"
(struct branch (ll ; Left Line
rl ; Right Line
lt ; Left subtree
rt) ; Right Subtree
#:transparent)
(define tree-points '())
(define (make-tree-point)
(let ([p (make-point)])
(set! tree-points (cons p tree-points))
;; Dirty Hack to make sure values are nice
(always (<= 0 (point-x p)) #:owner picture)
(always (<= 0 (point-y p)) #:owner picture)
;; End Hack
p))
(define (branch-tp b)
(if b
(line-end1 (branch-ll b))
#f))
(define (branch-leftmost b)
(if (branch-lt b)
(branch-leftmost (branch-lt b))
(line-end2 (branch-ll b))))
(define (branch-rightmost b)
(if (branch-rt b)
(branch-rightmost (branch-rt b))
(line-end2 (branch-rl b))))
(define (make-branch [lt #f] [rt #f])
(let* ([tp (make-tree-point)]
; use top point from left child, if it exists
[lp (or (branch-tp lt) (make-tree-point))]
; use top point from right child, if it exists
[rp (or (branch-tp rt) (make-tree-point))]
[ll (line tp lp)]
[rl (line tp rp)]
[b (branch ll rl lt rt)])
; 1. separation of bottom points (by 2x x-spacing)
(always (<= (+ branch-x-distrib (point-x lp))
(point-x rp)) #:owner picture)
(always (equal? (+ branch-x-distrib (point-x lp))
(point-x rp))
#:priority low #:owner picture)
; 2. bottom points are equally distributed around top point
(always (equal? (- (point-x tp) (point-x lp))
(- (point-x rp) (point-x tp))) #:owner picture)
; 3. Top point is always 30 above left and right point
(always (equal? (+ branch-y-spacing (point-y tp))
(point-y lp)) #:owner picture)
(always (equal? (+ branch-y-spacing (point-y tp))
(point-y rp)) #:owner picture)
(when lt
; 7. Rightmost point in left subtree is left of top point
(always (<= (+ branch-x-spacing (point-x (branch-rightmost lt)))
(point-x tp)) #:owner picture)
(always (equal? (+ branch-x-spacing (point-x (branch-rightmost lt)))
(point-x tp))
#:priority low #:owner picture)
)
(when rt
; 9. Leftmost point in right subtree is right of top point
(always (<= (+ branch-x-spacing (point-x tp))
(point-x (branch-leftmost rt))) #:owner picture)
(always (equal? (+ branch-x-spacing (point-x tp))
(point-x (branch-leftmost rt)))
#:priority low #:owner picture)
)
b))
(define (binary-tree-recur n)
(cond [(<= n 1) (make-branch)]
[else (let ([lt (binary-tree-recur (- n 1))]
[rt (binary-tree-recur (- n 1))])
(make-branch lt rt))]))
(define (binary-tree n x y)
(let* ([bt (binary-tree-recur n)])
(assert (equal? (point-x (branch-tp bt)) x))
(assert (equal? (point-y (branch-tp bt)) y))
bt))
(define (show-tree bt)
(show-tree-recur (send picture wally-evaluate bt)))
(define (show-tree-recur bt)
(let ([lt (branch-lt bt)]
[rt (branch-rt bt)])
(showthing (branch-ll bt) dc)
(showthing (branch-rl bt) dc)
(when lt
(show-tree-recur lt))
(when rt
(show-tree-recur rt))
))
(define test (binary-tree 4 300 50))
(printf "solving\n")
(time (send picture solve))
(printf "solved\n")
(define (showtest)
(show-tree test))
(send frame show #t)
;; This should be the result of (binary-tree 2 300 50)
;;
;; (branch
;; (line (point 300 50) (point 285 70))
;; (line (point 300 50) (point 315 70))
;; (branch
;; (line (point 285 70) (point 275 90))
;; (line (point 285 70) (point 295 90))
;; #f
;; #f)
;; (branch
;; (line (point 315 70) (point 305 90))
;; (line (point 315 70) (point 325 90))
;; #f
;; #f))