Paste: a binary-tree implementation in factor
Author: | randy7 |
Mode: | factor |
Date: | Fri, 15 Oct 2010 14:22:08 |
Plain Text |
USING: accessors fry kernel locals make math multiline
prettyprint sequences shuffle slots.syntax ;
QUALIFIED: math
IN: binary-tree
TUPLE: node parent left right { size-below initial: 0 } value ;
TUPLE: binary-tree { root node } ;
: <
[ value>> ] bi@ math:< ;
: >=
< not ;
: <node>
node new
swap >>value ;
: <binary-tree>
binary-tree new swap >>root ;
<PRIVATE
: inc-parent-size
parent>> dup
[
[ 1 + ] change-size-below inc-parent-size
] [ drop ] if ;
: add-child-on-right
over >>parent
[ >>right drop ]
[ nip inc-parent-size ] 2bi ;
: add-child-on-left
over >>parent
[ >>left drop ]
[ nip inc-parent-size ] 2bi ;
PRIVATE>
GENERIC: add-node
M: node add-node
2dup >= [
dup right>>
[ right>> add-node ] [ swap add-child-on-right ] if
] [
dup left>>
[ left>> add-node ] [ swap add-child-on-left ] if
] if ;
M: binary-tree add-node
root>> add-node ;
: add-value
<node> swap add-node ;
GENERIC: min
GENERIC: max
M: node min
dup left>> [ left>> min ] when ;
M: node max
dup right>> [ right>> max ] when ;
M: binary-tree min
root>> min ;
M: binary-tree max
root>> max ;
: root
dup parent>> [ parent>> root ] when ;
<PRIVATE
: (get-list)
[ left>> dup [ (get-list) ] [ drop ] if ]
[ , ]
[ right>> dup [ (get-list) ] [ drop ] if ] tri ;
PRIVATE>
GENERIC: items
M: node items
[ (get-list) ] { } make ;
M: binary-tree items
root>> items ;
: values
items [ value>> ] map ;
: print
values . ;
GENERIC: find-node*
: find-node
dup [ find-node* ] [ 2drop f ] if ;
M:: node find-node*
node value>> value =
[ node ]
[ value node left>> find-node :> left-result
left-result dup [ drop value node right>> find-node :> right-result
right-result dup [ drop f ] unless
] unless
] if ;
M: binary-tree find-node*
root>> find-node ;
: add-values
dupd [ add-value ] with each ;
: add-nodes
tuck '[ _ add-node ] each ;
: children
slots{ right left } ;
: right?
dup parent>> right>> eq? ;
<PRIVATE
: rm-child
[ parent>> ] [ right? ] bi
[ f >>right ] [ f >>left ] if drop ;
PRIVATE>
: remove
dup [
[ children harvest ] [ parent>> ] [ rm-child ] tri add-nodes
] when drop ;
: remove-nodes
[ remove ] each ;
: find-nodes
swap [ find-node ] curry map ;
: remove-values
find-nodes remove-nodes ;
Author: | randy7 |
Mode: | factor |
Date: | Fri, 15 Oct 2010 16:51:50 |
Plain Text |
the above code doesn't handle the case where the user wants to remove the root node.
right now, it asks the node's parent to add node's children.
but a root node doesn't have a parent. it would be f.
I read that on balanced trees, they take the left child's max, add its children (left or none) to its parent, then back to the top of the tree, use that node as the new root, and add the previous left and right to it.
it's pretty good, because the order is kept.
here's untested code
: root-remove
[ children ] [ left max dup remove f >>right f >>left ] bi add-nodes ;
: normal-remove
dup [
[ children harvest ] [ parent>> ] [ rm-child ] tri add-nodes
] when drop ;
: remove
dup root eq?
[ root-remove ] [ normal-remove ] if ;
New Annotation