steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

re-enable tree prettyprinting code. trees need refactoring or a rewrite someday

db4
Doug Coleman 2009-03-04 16:14:16 -06:00
parent 33a1a269f5
commit d9184fbf24
3 changed files with 25 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/trees/avl/avl.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2007 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: combinators kernel generic math math.functions
math.parser namespaces io prettyprint.backend sequences trees
assocs parser accessors math.order ;
math.parser namespaces io sequences trees
assocs parser accessors math.order prettyprint.custom ;
IN: trees.avl
TUPLE: avl < tree ;
@ -155,4 +155,4 @@ M: avl assoc-like
: AVL{
\ } [ >avl ] parse-literal ; parsing
! M: avl pprint-delims drop \ AVL{ \ } ;
M: avl pprint-delims drop \ AVL{ \ } ;

4
extra/trees/splay/splay.factor
View File

@ -1,7 +1,7 @@
! Copyright (c) 2005 Mackenzie Straight.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math namespaces sequences assocs parser
prettyprint.backend trees generic math.order accessors ;
trees generic math.order accessors prettyprint.custom ;
IN: trees.splay
TUPLE: splay < tree ;
@ -137,4 +137,4 @@ M: splay new-assoc
M: splay assoc-like
drop dup splay? [ >splay ] unless ;
! M: splay pprint-delims drop \ SPLAY{ \ } ;
M: splay pprint-delims drop \ SPLAY{ \ } ;

30
extra/trees/trees.factor
View File

@ -2,8 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel generic math sequences arrays io namespaces
prettyprint.private kernel.private assocs random combinators
parser prettyprint.backend math.order accessors deques make
prettyprint.custom ;
parser math.order accessors deques make prettyprint.custom ;
IN: trees
TUPLE: tree root count ;
@ -21,15 +20,17 @@ INSTANCE: tree assoc
TUPLE: node key value left right ;
: new-node ( key value class -- node )
new swap >>value swap >>key ;
new
swap >>value
swap >>key ;
: <node> ( key value -- node )
node new-node ;
SYMBOL: current-side
: left ( -- symbol ) -1 ; inline
: right ( -- symbol ) 1 ; inline
CONSTANT: left -1
CONSTANT: right 1
: key-side ( k1 k2 -- n )
<=> {
@ -46,24 +47,33 @@ SYMBOL: current-side
: node-link@ ( node ? -- node )
go-left? xor [ left>> ] [ right>> ] if ;
: set-node-link@ ( left parent ? -- )
go-left? xor [ (>>left) ] [ (>>right) ] if ;
: node-link ( node -- child ) f node-link@ ;
: set-node-link ( child node -- ) f set-node-link@ ;
: node+link ( node -- child ) t node-link@ ;
: set-node+link ( child node -- ) t set-node-link@ ;
: with-side ( side quot -- ) [ swap current-side set call ] with-scope ; inline
: with-side ( side quot -- )
[ swap current-side set call ] with-scope ; inline
: with-other-side ( quot -- )
current-side get neg swap with-side ; inline
: go-left ( quot -- ) left swap with-side ; inline
: go-right ( quot -- ) right swap with-side ; inline
: leaf? ( node -- ? )
[ left>> ] [ right>> ] bi or not ;
: random-side ( -- side ) left right 2array random ;
: random-side ( -- side )
left right 2array random ;
: choose-branch ( key node -- key node-left/right )
2dup key>> key-side [ node-link ] with-side ;
@ -192,6 +202,6 @@ M: tree assoc-like drop dup tree? [ >tree ] unless ;
\ } [ >tree ] parse-literal ; parsing
M: tree assoc-size count>> ;
! M: tree pprint-delims drop \ TREE{ \ } ;
! M: tree >pprint-sequence >alist ;
! M: tree pprint-narrow? drop t ;
M: tree pprint-delims drop \ TREE{ \ } ;
M: tree >pprint-sequence >alist ;
M: tree pprint-narrow? drop t ;