extra/rosetta-code/tree-traversal/tree-traversal.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators deques dlists io kernel
   4 math.parser ;
   5 IN: rosetta-code.tree-traversal
   6
   7 ! http://rosettacode.org/wiki/Tree_traversal
   8
   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:
  12
  13 !         1
  14 !        / \
  15 !       /   \
  16 !      /     \
  17 !     2       3
  18 !    / \     /
  19 !   4   5   6
  20 !  /       / \
  21 ! 7       8   9
  22
  23 ! The correct output should look like this:
  24
  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
  29
  30 TUPLE: node data left right ;
  31
  32 CONSTANT: example-tree
  33     T{ node f 1
  34         T{ node f 2
  35             T{ node f 4
  36                 T{ node f 7 f f }
  37                 f
  38             }
  39             T{ node f 5 f f }
  40         }
  41         T{ node f 3
  42             T{ node f 6
  43                 T{ node f 8 f f }
  44                 T{ node f 9 f f }
  45             }
  46             f
  47         }
  48     }
  49
  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
  55
  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
  61
  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
  67
  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* ]
  74             [ nip (levelorder) ]
  75         } 3cleave
  76     ] if ; inline recursive
  77
  78 : levelorder ( node quot: ( data -- ) -- )
  79     [ 1dlist ] dip (levelorder) ; inline
  80
  81 : levelorder2 ( node quot: ( data -- ) -- )
  82     [ 1dlist ] dip
  83     [ dup deque-empty? not ] swap '[
  84         dup pop-front
  85         [ data>> @ ]
  86         [ left>> [ over push-back ] when* ]
  87         [ right>> [ over push-back ] when* ] tri
  88     ] while drop ; inline
  89
  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 ]
  97     } 2cleave ;
  98
  99 MAIN: tree-traversal-main