Interval Tree
All rights reserved.
Author: Bo Morgan
Permission to use, copy, modify and distribute this software and its
documentation is hereby granted, provided that both the copyright
notice and this permission notice appear in all copies of the
software, derivative works or modified versions, and any portions
thereof, and that both notices appear in supporting documentation.
BO MORGAN ALLOWS FREE USE OF THIS SOFTWARE IN ITS "AS IS" CONDITION.
BO MORGAN DISCLAIMS ANY LIABILITY OF ANY KIND FOR ANY DAMAGES
WHATSOEVER RESULTING FROM THE USE OF THIS SOFTWARE.
Bo Morgan requests users of this software to return to bo@mit.edu any
improvements or extensions that they make and grant Bo Morgan the
rights to redistribute these changes.'
[defunk interval_tree‑test []
[let [[interval_tree [new interval_tree
[funk [x] [have x lookup `left]]
[funk [x] [have x lookup `right]]
[funk [x y] [== x y]]
[funk [x y] [< x y]]
[funk [x y] [/ [+ x y] 2.0]]
]]
[element_set [new set]]]
[let [[count 100]]
[dotimes [i count]
[print i]
[let [[choice [random 2]]]
[cond [[== choice 0]
[print 'add']
[let [[x [get [random 30] as‑double]]
[y [get [random 30] as‑double]]]
[let [[element nil]]
[if [< x y]
[= element [frame left x right y]]
[= element [frame left y right x]]]
[have interval_tree insert element]
[have element_set add element]]]]
[[== choice 1]
[if [> [length [get element_set elements]] 0]
[prog [print 'remove']
[let [[element [get element_set an_arbitrary_element]]]
[have interval_tree remove element]
[have element_set remove element]]]]]]]]]
interval_tree]]
[defunk rbt‑add_remove_test []
[let [[redblacktree [new redblacktree
[funk [x] [car x]]
[funk [x y] [< x y]]
]]
[element_set [new set]]]
[let [[count 100]]
[dotimes [i count]
[let [[choice [random 5]]]
[cond [[== choice 0]
[let [[x [get [random 3] as‑double]]]
[let [[element [cons x nil]]]
[terminal_format standard‑terminal
'\n' i ' ADD'
'\n before redblacktree: ' [get redblacktree leaves]
'\n element_set: ' [get element_set elements]]
[terminal_format standard‑terminal
'\n add element: ' element]
[have redblacktree insert element]
[have element_set add element]
[terminal_format standard‑terminal
'\n after redblacktree: ' [get redblacktree leaves]
'\n element_set: ' [get element_set elements]]
]]]
[[== choice 1]
[if [> [length [get element_set elements]] 0]
[let [[element [get element_set an_arbitrary_element]]]
[terminal_format standard‑terminal
'\n' i ' REMOVE'
'\n before redblacktree: ' [get redblacktree leaves]
'\n element_set: ' [get element_set elements]]
[terminal_format standard‑terminal
'\n remove element: ' element]
[have redblacktree remove element]
[have element_set remove element]
[terminal_format standard‑terminal
'\n after redblacktree: ' [get redblacktree leaves]
'\n element_set: ' [get element_set elements]]
]]]]]
]]
redblacktree]]
[defunk rbt‑min_max_test []
[let [[redblacktree [new redblacktree
[funk [x] [car x]]
[funk [x y] [< x y]]
]]
[element_set [new set]]]
[let* [[count 300]
[boundary [>> count 1]]]
[labels [[print_stat [rbt]
[if [not [null [get rbt head]]]
[prog [terminal_format standard‑terminal
'\n minimum: ' [get rbt minimum]
'\n maximum: ' [get rbt maximum]
'\n minimum !< ' boundary ': ' [get rbt minimum_not_less_than boundary]
'\n maximum !> ' boundary ': ' [get rbt maximum_not_greater_than_or_equal_to boundary]
]]]]]
[dotimes [i count]
[let [[choice [random 4]]]
[cond [[== choice 0]
[let [[x [get i as‑double]]]
[let [[element [cons x nil]]]
[terminal_format standard‑terminal
'\n' i ' ADD'
'\n before redblacktree: ' [get redblacktree leaves]
'\n element_set: ' [get element_set elements]]
[terminal_format standard‑terminal
'\n add element: ' element]
[have redblacktree insert element]
[have element_set add element]
[terminal_format standard‑terminal
'\n after redblacktree: ' [get redblacktree leaves]
'\n element_set: ' [get element_set elements]]
[print_stat redblacktree]
]]]
[[== choice 1]
[if [> [length [get element_set elements]] 0]
[let [[element [get element_set an_arbitrary_element]]]
[terminal_format standard‑terminal
'\n' i ' REMOVE'
'\n before redblacktree: ' [get redblacktree leaves]
'\n element_set: ' [get element_set elements]]
[terminal_format standard‑terminal
'\n remove element: ' element]
[have redblacktree remove element]
[have element_set remove element]
[terminal_format standard‑terminal
'\n after redblacktree: ' [get redblacktree leaves]
'\n element_set: ' [get element_set elements]]
[print_stat redblacktree]
]]]]]
]]]
redblacktree]]