Hello, all. I just posted this to comp.lang.misc, but my professor
told me about the Mozart users mailing list so I'm repeating. Hope you
don't mind. I am really growing to love the
Mozart/Oz language, but one thing that's been nagging me is that the
built-in storage types (arrays, dictionarys) only work for integers
and literals, and I couldn't find an arbitrary binary tree type when I
searched MOGUL. So I looked up a red-black binary tree algorithm and
implemented it in Oz. All you need to provide is a comparator
function, and you can store any object in the tree.
Another solution would be to use dictionaries and names, but sometimes
you really *do* want structural (by-value) identity and not token
identity. For instance, when you're implementing BDDs. The nice thing
about the way C++ and Java implement sets is that you just have to
implement a < operator and you can use the set on anything; this
Mozart/Oz tree is designed to work similarly.
Example:
Tr = {NewTree Value.'<'}
for I in 1..100 do
{Tr.insert I} % multiple inserts overwrite each other
end
{Browse {Tr.retrieve 4}} % browses '4'
{Browse {Tr.convert}} % browses a representation of the whole tree.
I hereby waive any legal rights I may have to this code.
Max Wilson
P.S. This code is OPI code, not functor code. Just drop NewTree into
any functor and you're good to go.
% ----------------------------------------------------------------------------
% ------Red/black binary trees for Mozart----------------------
% ----------------------------------------------------------------------------
% Because each node consists of a number of mutable features, which
need to be manipulated from % outside the object itself, it makes sense
to implement the nodes as dictionaries instead of objects.
% But I'm worried that that might slow us down by a constant factor,
for translating the feature
% names. (I don't know how efficient Mozart's caching system is). So
nodes are arrays instead, and
% we use variables as feature names.
% Basic algorithm comes from this web page. I presume it's pretty
standard.
% (http://www.cs.auckland.ac.nz/software/AlgAnim/red_black.html)
declare
fun {NewTree LTPred}
[Val Color Left Right Parent] = {List.number 1 5 1}
Root = {NewCell nil}
fun {NewNode X P}
N = {NewArray Val Parent nil} in
N.Val := X
N.Parent := P
N.Color := black
N
end
fun {Convert Node}
if Node==nil then nil
else
node(Value Color Left Right Parent) = {Array.toRecord node Node} in
node({Convert Left} Value Color {Convert Right})
end
end
fun {InsertTree X}
if @Root == nil then
Root := {NewNode X nil}
@Root
else
{Insert @Root X}
end
end
fun {RetrieveTree X}
if @Root == nil then
raise notfound(X) end
else
{Retrieve @Root X}
end
end
fun {Insert N X}
if {LTPred X N.Val} then
if N.Left == nil then
N.Left := {NewNode X N}
N.Left
else
{Insert N.Left X}
end
elseif {LTPred N.Val X} then
if N.Right == nil then
N.Right := {NewNode X N}
N.Right
else
{Insert N.Right X}
end
else
% overwrite previous value
N.Val := X
N
end
end
fun {Retrieve N X}
if {LTPred X N.Val} then
if N.Left == nil then
raise notfound(X) end
else
{Retrieve N.Left X}
end
elseif {LTPred N.Val X} then
if N.Right == nil then
raise notfound(X) end
else
{Retrieve N.Right X}
end
else
% overwrite previous value
N.Val
end
end
proc {Rotate N Left Right}
% Note that Left and Right in this proc shadow the outer scope
% Left and Right. That doesn't matter, though.
Y = N.Right in
N.Right := Y.Left
if Y.Left \= nil then
Y.Left.Parent := N
end
Y.Parent := N.Parent
if N.Parent == nil then
Root := Y
else
if N == (N.Parent).Left then
N.Parent.Left := Y
else
N.Parent.Right := Y
end
end
Y.Left := N
N.Parent := Y
end
proc {RB_Insert Value}
Inserted = {InsertTree Value}
X = {NewCell Inserted} in
@X.Color := red
for while: @X \= nil andthen @X.Parent \= nil andthen
@X.Parent.Color == red andthen @X.Parent.Parent \= nil
do
proc {Branch Left Right}
Y = @X.Parent.Parent.Right in
if Y\=nil andthen Y.Color == red then
@X.Parent.Color := black
Y.Color := black
@X.Parent.Parent.Color := red
X := @X.Parent.Parent
else
if @X == @X.Parent.Right then
X := @X.Parent
{Rotate @X Left Right}
end
% Not sure if this is an error in the algorithm that I'm
using.
% Why isn't this next section an Else clause?
@X.Parent.Color := black
@X.Parent.Parent.Color := red
{Rotate @X.Parent.Parent Right Left}
end
end in
if @X.Parent == @X.Parent.Parent.Left then
{Branch Left Right}
else
{Branch Right Left}
end
end
end
in
tree(insert:RB_Insert convert:fun{$} {Convert @Root} end
retrieve:RetrieveTree)
end
% Show tree's basic usage
declare
% demo here uses Drawer module from VanRoy & Haridi's Oz book for
readability
% available at
http://www2.info.ucl.ac.be/notes_de_cours/LINF1251/Drawer.oz
[Draw] = {Module.link ['Draw.ozf']}
Tr = {NewTree Value.'<'}
for I in 1..100 do
{Tr.insert I}
end
{Draw.draw {Tr.convert}} % or you can just {Browse} it instead
% Let's say we want to do a map-like construction instead of a set. All
we
% need is a different < function that considers only the first part of
a
% cons pair. Then we insert pairs into the tree. Could add some
type-checking
% in the future. This map, like the basic set-like tree before it,
relies on
% integer keys. You'd wrap this in another function for a real map
interface.
declare
Tr2 = {NewTree fun{$ A B} AKey#AVal = A BKey#BVal = B in AKey < BKey
end}
for I in ~100..100 do
Msg = {String.toAtom {VirtualString.toString "I have "#I#" fish in
my pocket."}} in
{Tr2.insert I#Msg}
end
{Tr2.insert 0#'No fish'}
{Draw.draw {Tr2.convert}} % or you can just {Browse} it instead
{Show {Tr2.retrieve 4#_}}
{Show {Tr2.retrieve 0#_}}
{Show {Tr2.retrieve ~100#_}}
{Show {Tr2.retrieve 200#_}} % raises 'notfound(200)'
--
Be pretty if you are,
Be witty if you can,
But be cheerful if it kills you.
_________________________________________________________________________________
mozart-users mailing list
[email protected]
http://www.mozart-oz.org/mailman/listinfo/mozart-users
