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
|
(in-package #:cl-containers-test)
(deftestsuite test-trees (cl-containers-test)
())
(addtest (test-trees)
insert-delete-consistency
(ensure-cases (class)
'(binary-search-tree
red-black-tree)
(let ((c (make-instance class)))
(insert-item c 31)
(ensure-same (size c) 1 :test '=)
(delete-item c 31)
(ensure-same (size c) 0 :test '=)
)))
(addtest (test-trees)
searching-and-deleting-keyed
(ensure-cases (class)
'(binary-search-tree
red-black-tree)
(let ((b (make-container class
:key #'first
:test #'equal)))
(insert-list b '((2) (3) (10) (1) (4)))
(ensure-same (size b) 5)
(ensure-same (first (first-item b)) 1)
(ensure-same (search-for-node b 1 :key #'first) (containers::first-node b))
(delete-item b '(2))
(ensure-same (size b) 4)
(insert-item b '(7))
(insert-item b '(-2))
(insert-item b '(12))
(ensure-same (size b) 7)
(empty! b)
(ensure-same (size b) 0)
)))
(addtest (test-trees)
find-on-nonexistant-item
(ensure-cases (class)
'(binary-search-tree
red-black-tree)
(let ((c (make-instance class)))
(ensure-null (item-at c 1))
(ensure-null (find-element c 1))
(ensure-null (find-item c 1))
(ensure-null (find-node c 1))
)))
(addtest (test-trees)
find-on-nonexistant-item-nonempty
(ensure-cases (class)
'(binary-search-tree
red-black-tree)
(let ((c (make-instance class)))
(insert-list c '(64 83 68 84 97))
(ensure-null (item-at c 1))
(ensure-null (find-element c 1))
(ensure-null (find-item c 1))
(ensure-null (find-node c 1))
)))
(addtest (test-trees)
randomized-testing
(ensure-cases (class)
'(binary-search-tree
red-black-tree)
(let* ((count 20)
(randlist (loop repeat count
collect (random 100)))
(c (make-container class )))
(loop for n in randlist
do (insert-item c n))
(ensure-same (size c) count)
(ensure-same (first-element c) (apply #'min randlist))
(ensure-same (last-element c) (apply #'max randlist))
(loop for n in randlist
do (ensure (item-at c n))
do (ensure (find-item c n)))
(ensure-same (collect-elements c)
(sort (copy-list randlist) #'<)
:test #'equal)
;;now remove half the elements and make sure it still makes sense.
(loop repeat (/ count 2)
for n = (pop randlist)
do (ensure (typep (delete-element c n)
'containers::bst-node)))
(ensure-same (size c) (length randlist))
(ensure-same (first-element c) (apply #'min randlist))
(ensure-same (last-element c) (apply #'max randlist))
(loop for n in randlist
do (ensure (item-at c n))
do (ensure (find-item c n)))
(ensure-same (collect-elements c)
(sort (copy-list randlist) #'<)
:test #'equal)
;;remove the rest
(ensure-null (empty! c))
(ensure (empty-p c))
(ensure-same (size c) 0)
(ensure-null (collect-elements c)))))
#|
(setf c (make-instance 'red-black-tree))
(insert-item c 1)
(delete-item c 2)
(size c)
c
(collect-nodes c)
(collect-elements c)
(delete-item c 1)
(trace delete-item)
(trace delete-node)
(trace)
(delete-element c 1)
(find-element c 1)
(compute-applicable-methods #'size (list c))
(compute-applicable-methods #'collect-nodes (list c))
(compute-applicable-methods #'iterate-nodes (list c #'identity))
(compute-applicable-methods #'delete-item (list c 1))
|#
|
