1 ! Copyright (c) 2012 Anonymous
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators deques dlists io kernel
5 IN: rosetta-code.tree-traversal
7 ! https://rosettacode.org/wiki/Tree_traversal
9 ! Implement a binary tree where each node carries an integer,
10 ! and implement preoder, inorder, postorder and level-order
11 ! traversal. Use those traversals to output the following tree:
23 ! The correct output should look like this:
25 ! preorder: 1 2 4 7 5 3 6 8 9
26 ! inorder: 7 4 2 5 1 8 6 9 3
27 ! postorder: 7 4 5 2 8 9 6 3 1
28 ! level-order: 1 2 3 4 5 6 7 8 9
30 TUPLE: node data left right ;
32 CONSTANT: example-tree
50 : preorder ( node quot: ( data -- ) -- )
51 [ [ data>> ] dip call ]
52 [ [ left>> ] dip over [ preorder ] [ 2drop ] if ]
53 [ [ right>> ] dip over [ preorder ] [ 2drop ] if ]
54 2tri ; inline recursive
56 : inorder ( node quot: ( data -- ) -- )
57 [ [ left>> ] dip over [ inorder ] [ 2drop ] if ]
58 [ [ data>> ] dip call ]
59 [ [ right>> ] dip over [ inorder ] [ 2drop ] if ]
60 2tri ; inline recursive
62 : postorder ( node quot: ( data -- ) -- )
63 [ [ left>> ] dip over [ postorder ] [ 2drop ] if ]
64 [ [ right>> ] dip over [ postorder ] [ 2drop ] if ]
65 [ [ data>> ] dip call ]
66 2tri ; inline recursive
68 : (levelorder) ( dlist quot: ( data -- ) -- )
69 over deque-empty? [ 2drop ] [
70 [ dup pop-front ] dip {
71 [ [ data>> ] dip call drop ]
72 [ drop left>> [ swap push-back ] [ drop ] if* ]
73 [ drop right>> [ swap push-back ] [ drop ] if* ]
76 ] if ; inline recursive
78 : levelorder ( node quot: ( data -- ) -- )
79 [ 1dlist ] dip (levelorder) ; inline
81 : levelorder2 ( node quot: ( data -- ) -- )
83 [ dup deque-empty? not ] swap '[
86 [ left>> [ over push-back ] when* ]
87 [ right>> [ over push-back ] when* ] tri
90 : tree-traversal-main ( -- )
91 example-tree [ number>string write bl ] {
92 [ "preorder: " write preorder nl ]
93 [ "inorder: " write inorder nl ]
94 [ "postorder: " write postorder nl ]
95 [ "levelorder: " write levelorder nl ]
96 [ "levelorder2: " write levelorder2 nl ]
99 MAIN: tree-traversal-main