-
Notifications
You must be signed in to change notification settings - Fork 320
/
ch-1.p6
143 lines (118 loc) · 4.28 KB
/
ch-1.p6
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
#!/usr/bin/env raku
use v6;
# BTree as string nodevalue[child1,child2]
# Example tree 5(4(11(7)(2)))(8(13)(9(1)))
grammar BTreeGrammar {
token TOP { <tree> };
token tree { <value> ["(" $<left>=<tree> ")"]? ["(" $<right>=<tree> ")"]? };
regex value { <-[()]>+ }
}
class BTreeRep {...}
role BTree[::T] {
has T $.value is required;
has BTree @!nodes[2];
method Str( ) {
( $!value , |@.nodes.map( { "({$_})" } ) ).join("");
}
method nodes() {
@!nodes.grep({defined $_});
}
method children() {
@.nodes.elems;
}
method gist() {
BTreeRep.new( tree=>self ).gist();
}
method traverse() {
gather {
if ( self.children ) {
for @.nodes -> $n {
for $n.traverse -> @t {
take ($!value, |@t);
}
}
} else {
take ( $!value, );
}
}
}
multi method reverse( ::?CLASS:D: ) {
self.new(
value => $!value,
nodes => @.nodes.reverse.map( *.reverse )
)
}
multi method from-Str('') { BTree }
multi method from-Str( ::?CLASS:U: Str $in ) {
my $match = BTreeGrammar.parse( $in );
if ( $match ) {
self.new(
value => $match<tree><value>.Str,
nodes => [
self.from-Str( $match<tree><left> ?? $match<tree><left>.Str !! '' ),
self.from-Str( $match<tree><right> ?? $match<tree><right>.Str !! '' )
]
);
} else {
die "Unable to Parse $in";
}
}
}
class UBTree does BTree[UInt] {
submethod BUILD ( UInt() :$value, :@nodes ) {
$!value = $value;
@!nodes = @nodes;
}
}
class BTreeRep {
has @.data;
has UInt $.join-point;
multi submethod BUILD ( BTree :$tree where { ! $tree.children } ) {
@!data = [$tree.value.Str];
$!join-point = $tree.value.Str.codes div 2;
}
multi submethod BUILD ( BTree :$tree ) {
my ( $left, $right, $left-width, $right-width );
my ( @ldata, @rdata, $left-pad, $right-pad );
my $mid-string = '┘';
$left = BTreeRep.new( tree => $tree.nodes[0] );
$left-width = $left.data[0].codes;
@ldata = $left.data;
@ldata.unshift( (" " x $left.join-point) ~ "┌" ~ ("─" x ($left-width - 1 - $left.join-point) ) );
if ( $tree.children == 2 ) {
my $right = BTreeRep.new( tree => $tree.nodes[1] );
$mid-string = '┴';
@rdata = $right.data;
$right-width = @rdata[0].codes;
@rdata.unshift( ( "─" x ( $right.join-point ) ~ '┐' ~ ( " " x $right-width - 1 - $right.join-point ) ) );
} else {
$right-width = 1;
@rdata = @ldata.map( { " " } );
}
if ( $left-width + $right-width + 1 < $tree.value.codes ) {
$left-pad = 0;
$right-pad = 0;
my $extra = $tree.value.codes - ($left-width + $right-width + 1);
@ldata = @ldata.map( { ( " " x ( $extra div 2 ) ) ~ $_ } );
@rdata = @rdata.map( { $_ ~ ( " " x ( $extra div 2 + $extra % 2 ) ) } );
} else {
$left-pad = $left-width - ($tree.value.codes div 2);
$right-pad = ($left-width + $right-width + 1) - $left-pad - $tree.value.codes;
}
my $top = ( " " x $left-pad ) ~ $tree.value ~ ( " " x $right-pad );
my $left-fill = gather { for @ldata.elems^..@rdata.elems { take " " x $left-width } };
my $right-fill = gather { for @rdata.elems^..@ldata.elems { take " " x $right-width } };
@!data = $top, |( ( (|@ldata, |$left-fill) Z, (|@rdata, |$right-fill) ).map( { state $i=0;$_.join($i++??" "!!$mid-string) } ) );
$!join-point = $left-pad + ( $tree.value.Str.codes div 2);
}
method gist {
@.data.join("\n");
}
}
#| Given a tree string prints it then reverses all the nodes and reprints it
#| Note the Tree string is in the format "number (left tree) (right tree)" spaces are optional
multi sub MAIN ( *@rest ) {
my $tree = UBTree.from-Str( @rest.join("") );
say "Tree :\n{$tree.gist}\n";
say "Reversed :\n{$tree.reverse.gist}\n";
}