Re: Challenge: Dumping trees.
by moritz (Cardinal) on Oct 13, 2012 at 09:28 UTC
|
I'm not sure, but maybe such a structure is easier to create:
┼┬┬┬┬┬a
│││││└b
││││└c
│││└┬d
│││ └e
││├┬┬┬f
│││││└g
││││└h
│││└┬┬i
│││ │└j
....
My inspiration is https://github.com/perl6/std/blob/master/viv#L187 which produces parse trees like
└─VAST::statementlist, BEG: 0, END: 7
├─VAST::statement, BEG: 0, END: 7
│ └─VAST::term__S_identifier, BEG: 0, END: 7, SYM: identifier, _from: 7,
│ │ _pos: 7, _specific: 1, dba: term, prec: z=
│ ├─VAST::identifier, BEG: 0, END: 3, TEXT: say
│ └─VAST::args, BEG: 3, END: 7, invocant: undef
│ └─VAST::arglist, BEG: 4, END: 7, WS: 1
│ └─VAST::term__S_value, BEG: 4, END: 6, SYM: value, WS: 1,
│ │ _specific: 1
│ └─VAST::value__S_number, BEG: 4, END: 6, SYM: number, WS: 1,
│ │ _specific: 1
│ └─VAST::number, BEG: 4, END: 6, WS: 1
│ └─VAST::integer, BEG: 4, END: 6, WS: 1
│ └─VAST::decint, BEG: 4, END: 6, TEXT: 42, WS: 1
└─VAST::eat_terminator, BEG: 7, END: 7, TEXT: , WS: 1
Update: just today a Perl 6 solution for Visualize a tree on rosettacode was entered, it produces similar output:
root
├─a
│ └─a1
│ └─a11
└─b
├─b1
│ └─b11
├─b2
└─b3
Shouldn't be to hard to port to Perl 5.
| [reply] |
Re: Challenge: Dumping trees.
by Anonymous Monk on Oct 13, 2012 at 15:42 UTC
|
_____/\_____
___________/\_ ___/\
_______________/\_ /\_ /\_ z
___/\_____ /\_____ t /\ w /\
_/\_ _/\___ n _/\_ u v x y
_/\ /\ _/\ _/\_ _/\ /\
/\ c d e /\ h /\ /\_ /\ q r s
a b f g i j k /\ o p
l m
Naturally nodes with a width greater than 2 chars breaks it :) | [reply] [d/l] [select] |
|
Naturally nodes with a width greater than 2 chars breaks it :)
Thank you anonymonk. That handles everything I've thrown at it -- which it a darn sight more than I can say for my attempts so far.
It occasionally produces an oddity -- see the 'wxyz' nodes in the second example and the '1' node in the last two examples -- but they are still clear enough for my purposes.
C:\test>genBiaryTree -W=1 -S=2 | junk.pl
______________________________________________________
+________________________________________________/\_
_______/\_____________________________________________________
+_____________________________________________ /\
_/\___
+ _____________________________/\_ Y Z
_/\ _/\_ ____________________________________
+______________/\_ /\
_/\ d /\ /\ ___________/\_____________
+ /\___ W X
/\ c e f g h ___/\_____ _______/\____
+ H _/\_
a b /\_ _/\___ ___/\_____ __/\________________
+_______ /\ /\_
i /\ _/\ _/\ /\_ ___/\ /\ _______________
+______/\_____ I J K /\___
j k /\ n /\ q r /\ /\_ x y / /\_
+ ___/\ L _/\___
l m o p s t u /\ z 1 /\____________
+___ /\_ G /\ _/\_________
v w 2 ___________
+__/\_ D /\ M N /\ _____/\
/\_________
+ /\ E F O P _/\___ V
3 _______/\
+_ B C /\ _/\
/\_
+/\ Q R /\ U
4 /\___ 9
+ A S T
5 _/\
/\ 8
6 7
C:\test>genBiaryTree -W=1 -S=3 | junk.pl
_____________________________/\___________________________________
+___________________________________________________
_/\___________________
+ ___________________________________/\
/\ _________/\_______ _________________
+______________/\_______________________________ Z
a b _____/\_______ _____/\ ____/\________________
+_____ _______________/\_
_/\___ _____/\ /\_ q ___/\ _______________
+____/\_______ _____/\_ /\
/\ _/\ /\_ l m /\_ _/\_ _/ /\___
+ ___/\ _______/\___ /\_________ X Y
c d /\ g h /\_ n /\ _____/\ //\ 1 _/\___
+ _/\_ G /\_____ _/\ P _/\_
e f i /\ o p /\___ v wyxz /\ _/\______
+_ /\ /\ H ___/\ /\ O ___/\ /\
j k r _/\ 2 3 /\ _____
+/\_ C D E F /\_ L M N _/\_ U V W
/\ u 4 5 /\_
+ /\ I /\ /\ /\
s t 6 /\_
+ A B J K Q R S T
7 /\
8 9
C:\test>genBiaryTree -W=1 -S=4 | junk.pl
____________________________________
+__________/\_____________________________________
___________________________/\_______________
+ _____/\_
_/\_____________________ ___________/\___________________
+_ _____________________________/\_ /\
_/\ _/\_ _/\_________ _____________
+/\_______ /\_______________________ /\_ Y Z
/\ c _______/\ /\_ /\ _/\ ____/\___________
+ _____/\ F _________/\___ V /\
a b ___/\_ n o /\ r s ___/\ y /\__ _________/\
+ /\_ E _______/\_____ _/\ W X
___/\_ /\_ p q _/\_ x z _/\ /\_ 9
+ A /\_ _/\___ ___/\_ /\ U
_/\_ /\ j /\_ /\ /\ \ 2 3 /\_
+ B /\ _/\ _/\_ /\_ /\ S T
/\ /\ h i k /\ t u v w 1 4 /\_
+ C D /\ I /\ /\ N /\ Q R
d e f g l m 5 /\_
+ G H J K L M O P
6 /\
7 8
C:\test>genBiaryTree -W=1 -S=40 | junk.pl
______________________________/\________
+_
_______________/\_________ ___
+/\_______________
_/\_ _______/\_ ___/\_
+ ___________/\_____
_____/\ /\_ /\___ /\_______ /\_ /\
+ _/\_______ _/\_________
_/\_ g h /\___ p _/\_ u _/\_ 5 /\ 8 9
+ /\ ___/\_ _/\ _______/\_________
_/\ /\_ i _/\___ /\ /\ ___/\ /\__ 6 7
+ A B _/\_ /\ /\ K /\___ ___/\___
/\ c d /\ /\ _/\_ q r s t /\_ y z _/\___
+ /\ /\ G H I J L _/\_ ___/\_ _/\_
a b e f j k /\ /\ v /\ \ _/\
+ C D E F /\ /\ /\_ /\ /\ /\_
l m n o w x 1 /\ 4
+ M N O P Q /\ T U V W X /\
2 3
+ R S Y Z
C:\test>genBiaryTree -W=1 -S=400 | junk.pl
_____________________________/\_____________________________
+___________________________
_______/\_______
+ _________________________/\_
/\_____ ___/\_______ ______________________
+/\___________ /\_______________
a ___/\ _/\_ ___/\_ _____/\________________
+ _/\_ N ___________/\_
/\_ e /\ /\ _/\_ /\_ /\_ ___/\___
+ _______/\ /\_____ _/\_ /\_
b /\ f g h i /\ /\ n /\_____ u /\_ _______/\_ _/\
+ /\___ F G ___/\_ /\ /\_____ W /\_
c d j k l m o _/\_ v /\ /\_____ /\ /\ 9
+ A _/\_ /\_ /\_ O P Q ___/\_ X /\
_/\ /\ w x _/ _/\ 5 6 7 8
+ /\ /\ H /\ K /\ /\_ /\ Y Z
/\ r s t /\ _/\ 4
+ B C D E I J L M R /\ U V
p q y z /\ 3
+ S T
1 2
C:\test>genBiaryTree -W=1 -S=400000 | junk.pl
+ _________________________________/\___
__________________
+________/\___________________ _/\_
_______________________________________________/\_________________
+_______ ___/\_________ /\ /\_
_/\_________________________ _________________
+______/\ ___/\_ _/\_ V W X /\
/\ ___/\___ \ _
+ D ___/\_ /\ ___/\ /\ Y Z
a b _____/\_ _/\_______ /\______________
+_ ___/\_ /\ M N _/\_ S T U
_______/\_ /\ /\ _/\_______ 1 ___________
+/\___ _/\_ /\ K L /\ /\
___/\_ /\_ n o p q _/\ _/\ _/\_____
+ _/\ /\ /\ I J O P Q R
_/\_ /\_ k /\ _/\ u ___/\ z /\ ___/\_
+ /\ C E F G H
/\ /\ g /\_ l m /\ t /\_ y 2 3 /\_ /\_
+ A B
c d e f h /\ r s v /\ 4 /\ 7 /\
i j w x 5 6 8 9
C:\test>genBiaryTree -W=1 -S=99999400000 | junk.pl
_________________/\_________________
___/\_______________ _____________/\_____
_/\_ _________/\ _/\___ ___/\_________________
+_______________________________________________
_/\ /\ ___/\_______ n /\ _/\___ /\_
+ _____/\_
/\ c d e /\_ _/\ o p /\ _/\___ x /\
+ ___________________/\___ /\_
a b f /\ ___/\ m q r /\ _/\ y z
+ ___________/\_____________ _/\ X /\
g h /\_ l s t /\ w
+ _____/\_____ _______/\_ /\ W Y Z
i /\ u v _____
+__/\___ ___/\_ ___/\_____ /\_ U V
j k _/\____
+_ _/\ /\_ /\_ /\_ _/\ R /\
___/\ ___
+/\ /\ D E /\ H /\ K /\ _/\ Q S T
_/\_ 6 /\_
+ A B C F G I J L M /\ P
_/\ /\ 7 /\
+ N O
_/\ 3 4 5 8 9
\ 2
1
I'm going to try and adapt it to produce a slightly different style of output that I think results in nicer -- cleaner, more easily read -- output. Eg. Instead of: _____/\_____
___________/\_ ___/\
_______________/\_ /\_ /\_ z
___/\_____ /\_____ t /\ w /\
_/\_ _/\___ n _/\_ u v x y
_/\ /\ _/\ _/\_ _/\ /\
/\ c d e /\ h /\ /\_ /\ q r s
a b f g i j k /\ o p
l m
This: _______
___________/ \___
___________/ \_ _/ \
_______/ \_____ / \_ / \_ z
_/ \___ / \_ t / \ w / \
_/ \_ _/ \__ n _/ \_ u v x y
_/ \ / \ _/ \ _/ \ _/ \ / \
/ \ c d e / \ h / \ /\_ / \ q r s
a b f g i j k / \ o p
l m
Also, one possibility for handling node 'names' of more than 1 or 2 chars; though I'm not sure it really works as is?: _______
___________/ \___
___________/ \_ _/ \
_______/ \_____ / \_ / \_ z
_/ \___ / \_ t / \ w / \ u
_/ \_ _/ \__ n _/ \_ a u v h x y l
_/ \ / \ _/ \ _/ \ o _/ \ / \ n n i i r a u
/ \ c d e / \ h / \ /\_ v / \ q r s g i c s a n
a b h e c f g o i j k / \ e o p u o i o f t k y k
l r a l h o o t n u i l m m s a e m e o o e e
p a r t o x l e d l l i i b c p b e r r r y y
h v l a t f l i i o m k e a a e o r m
a o i r g e a w r r c a
e o o t
t
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
RIP Neil Armstrong
| [reply] [d/l] [select] |
|
Upon further testing, the anomalies I noted in Re^2: Challenge: Dumping trees. were actually more prevalent and distracting than I first thought; and I failed in my attempts to cure them in your code.
I also finally succeeded in getting my attempt to work properly. In part, because of a couple of things I learnt from studying your code. Thank you.
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
RIP Neil Armstrong
| [reply] |
|
I also finally succeeded neat :) it really is much easier on the eyes
Upon further testing, the anomalies
Hmm, weird. Using your tree generator
And running
I was not able to reproduce the anomalies, I get
| [reply] [d/l] [select] |
|
|
Re: Challenge: Dumping trees.
by jmcnamara (Monsignor) on Oct 13, 2012 at 09:13 UTC
|
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper::Perltidy;
$Data::Dumper::Perltidy::ARGV = '-i=4 -boc -nopro';
my $data = [
[
[[[[["a", "b"], "c"], ["d", "e"]], [[["f", "g"], "h"], [["
+i", "j"],
["k", ["l", "m"]]]]],
["n", [[["o", "p"], "q"], ["r", "s"]]]], ["t", ["u", "v"]]
],
[["w", ["x", "y"]], "z"]
];
print Dumper $data;
__END__
Which gives a structure similar to your hand manipulated example:
The perltidy options are explained in the Perltidy manpage.
Update: actually this isn't much of an improvement over the base Data::Dumper formatting due to the -boc option but without it Perl::Tidy compacts the branches too much. So, it probably isn't useful in this case.
--
John.
| [reply] [d/l] [select] |
Re: Challenge: Dumping trees.
by Anonymous Monk on Oct 13, 2012 at 02:58 UTC
|
I've spent the last couple of days trying to code this but haven't yet succeeded. Any offers? (NOTE: I'm looking for a compact dump to a terminal; not presentation quality graphics here. Ie. I'm not looking for GraphViz or similar, so please don't tell me about those.)
Hmmm. I've seen something resembling that in Tree::Visualize, I'm sure the BOX-ing can be easily undone ... Tree::Visualize::ASCII::BoundingBox ... here is a start
See also http://stackoverflow.com/questions/801740/c-how-to-draw-a-binary-tree-to-the-console which appears right on the money but I've not tested it
I really am surprised there isn't something in the GraphViz family to do this already, graph-easy can read DOT files but the output isn't exactly what you want
| [reply] [d/l] |
Re: Challenge: Dumping trees.
by hdb (Monsignor) on Sep 21, 2013 at 20:36 UTC
|
I am not sure if I add a new approach as I have not studied all posts in this thread in much detail. My code is just a bit shorter and I think a pretty direct approach to the problem.
use strict;
use warnings;
sub prepare {
my( $subtree, $level, $col, $graph ) = @_;
my $lcol = 0;
if( ref($subtree) ) {
$lcol = prepare( $subtree->[0], $level+1, $col, $graph ); # par
+se left side of tree, keep top position
$lcol and $graph->[$level]->[$_] = '_' for $lcol..$$col-1; # dra
+w horizontal line
$graph->[$level]->[$$col++] = '/';
$lcol = $$col; # new
+ root of the tree
$graph->[$level]->[$$col++] = '\\';
my $rcol = prepare( $subtree->[1], $level+1, $col, $graph ); # par
+se right side of the tree, keep its top position
$rcol and $graph->[$level]->[$_] = '_' for $lcol+1..$rcol-1; # dra
+w horizontal line
} else {
$graph->[$level]->[$$col++] = $subtree; # lea
+f
}
return $lcol; # ret
+urn column of root
}
my $root = do {
my $r;
my @a = ( 'a'..'z', 1..9, 'A'..'Z' );
$r = int( rand $#a ), splice @a, $r, 2, [ @a[ $r, $r+1 ]] while @a
+ > 1;
$a[0];
};
my @graph;
my $col = 0;
prepare( $root, 0, \$col, \@graph );
for my $row ( @graph ) {
print $_ // ' ' for @$row;
print "\n";
}
UPDATE: Here is some sample output for a smaller tree:
_____/\_
+_
__________________________/\__
+/\__
____________________/\________ /\ x
+ /\
__/\________ _____/\___________ v w
+ y z
__/\ _____/\__ /\__ __/\__
__/\ e /\__ /\__ m /\ _____/\ /\
__/\ d f /\ i /\__ n o /\__ s t u
/\ c g h j /\ p /\
a b k l q r
| [reply] [d/l] [select] |
|
On first blush, that appears to be astonishingly ... astonishing. Um. That's not good English is it. I'll try again.
After scant consideration, that appears to be remarkably ... remarkable. D'oh!
I will adapt it to produce my preferred, revised format -- contrast original format with my revised, preferred format so that I can compare like-for-like with my final version.
Then I'll get back to you.
Meantime, that's impressive!
Weirdly, I especially like the comments. If that sounds strange, trust me, it is even stranger, given that I (generally) hate comments.
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
| [reply] |
|
use strict;
use warnings;
use constant { LEFT => 0, RIGHT => 1 };
sub prepare {
my( $subtree, $lr, $level, $col, $graph ) = @_;
if( ref($subtree) ) {
my $lcol = prepare( $subtree->[LEFT ], LEFT, $level+1, $col, $gra
+ph );
$$col+=2;
my $rcol = prepare( $subtree->[RIGHT], RIGHT, $level+1, $col, $gra
+ph );
$graph->[$level]->[$lcol] = '/';
$graph->[$level-1]->[$_] = '_' for $lcol+1..$rcol-1;
$graph->[$level]->[$rcol] = '\\';
return $lr == LEFT ? $rcol : $lcol; # intentionally the other way
+ round !!
} else {
$graph->[$level]->[$$col] = $subtree;
return $$col;
}
}
my $root = do {
my $r;
my @a = ( 'a'..'z', 1..9, 'A'..'Z' );
$r = int( rand $#a ), splice @a, $r, 2, [ @a[ $r, $r+1 ]] while @a >
+ 1;
$a[0];
};
my @graph;
my $col = 0;
prepare( $root, LEFT, 1, \$col, \@graph ); # need to start with $level
+ = 1 !
for my $row ( @graph ) {
print $_ // ' ' for @$row;
print "\n";
}
and it looks like this:
_____________
_____________/ \_______
+__________
_____/ \_________ _/
+ \___________________________
_____________/ \_______ _/ \ / \ ___
+__________/ \_________
_________/ \ _/ \_ / \___ 4 5 6 _/
+ \_______ ___/ \_
_/ \_____ o _/ \_ _/ \ x / \_ / \_
+ ___/ \_ _/ \_ _/ \
_/ \_ ___/ \_ / \ / \_ / \ w y _/ \_ 7 / \_
+ ___/ \___ / \_ / \ _/ \_ / \ Z
/ \ / \ _/ \_ _/ \_ p q r / \ u v / \ / \ 8 /
+\ / \_ / \_ J / \___ Q R / \ / \_ X Y
a b c d / \_ / \ / \ / \_ s t z 1 2 3 9
+A B _/ \ F _/ \ K / \_ S T U / \
e / \ h i j k l / \
+ / \ E / \ I L _/ \_ V W
f g m n
+ C D G H / \ / \
+ M N O P
UPDATE:
Replacing the 2 in line $$col+=2; with a larger number makes the tree wider which might be useful for readability.
Replacing the line $graph->[$level]->[$$col] = $subtree; with $graph->[$level++]->[$$col] = $_ for split //, $subtree; will print leaf values vertically. | [reply] [d/l] [select] |
|
Re: Challenge: Dumping trees.
by remiah (Hermit) on Oct 14, 2012 at 06:25 UTC
|
#!/usr/bin/perl
#HTML version
use strict;use warnings;
use ArrayRef2HTMLTree;
my $t=[
[
[[[[["a", "b"], "c"], ["d", "e"]], [[["f", "g"], "h"], [["i",
+ "j"], ["k", ["l", "m"]]]]],
["n", [[["o", "p"], "q"], ["r", "s"]]]], ["t", ["u
+", "v"]]
],
[["w", ["x", "y"]], "z"]
];
my $ht = ArrayRef2HTMLTree->new(font_size=>'8pt',line_height=>'10px');
print $ht->to_html($t);
And my package.
#
package ArrayRef2HTMLTree;
use strict; use warnings;
our $HTML;
sub new{
my $class=shift;
my %args=@_;
$args{line_height}='10px' if(! exists $args{line_height});
$args{font_size}='8pt' if(! exists $args{font_size});
return bless \%args ,$class;
}
sub to_html{
my $self=shift;
my $t=shift;
my $tree=join('', '<ul class="tree">' , "\n" , traverse($t,0) , "\
+n", '</ul>', "\n");
my $html=$HTML;
$html =~ s/#TREE#/$tree/s;
$html =~ s/#LINE-HEIGHT#/$self->{line_height}/s;
$html =~ s/#FONT-SIZE#/$self->{font_size}/s;
return $html;
}
sub traverse {
my ($t,$depth)=@_;
my $tab="\t"x$depth;
if (ref($t) eq 'ARRAY'){
return
$tab , "<li>($depth)<ul>" , "\n" ,
(map{ traverse($_,$depth+1) } @$t) ,
$tab, "</ul></li>" , "\n";
} else {
return "$tab<li>$t</li>\n";
}
}
$HTML=<<'HTML';
<html><head><style>
body{
background-color: #FFFFFF; /*白*/
}
ul.tree, ul.tree ul{
list-style-type: none;
background: url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEA
+AAAKAQMAAABPHKYJAAAAA1BMVEWIiIhYZW6zAAAACXB
padding:0;
margin:0;
}
ul.tree ul{
margin-left: 10px;
border: lightgreen 0px solid;
}
ul.tree li{
margin:0px;
padding: 0 10px;
border: green 0px solid;
line-height: #LINE-HEIGHT#;
background: url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA
+AAAUAQMAAACK1e4oAAAABlBMVEUAAwCIiIgd2JB2AAA
color: #696969;
font-size: #FONT-SIZE#;
}
ul.tree li:last-child{
background: #fff url('data:image/png;base64,iVBORw0KGgoAAAANSUhEUg
+AAAAgAAAAUAQMAAACK1e4oAAAABlBMVEUAAwCIiIgd2
}
</style></head>
<body>
#TREE#
</body>
</html>
HTML
1;
regards.
| [reply] [d/l] [select] |
Re: Challenge: Dumping trees.
by tybalt89 (Monsignor) on Nov 29, 2022 at 21:02 UTC
|
Just because it looked like fun, and so far there are no examples of horizontal word trees.
#!/usr/bin/perl
use strict;
use warnings; # https://perlmonks.org/?node_id=998803
my $tree = [ [ [[[[["a", "b"], "c"], ["d", "e"]], [[["f", "g"], "h"],
+[["i", "j"], ["k", ["l", "m"]]]]], ["n", [[["o", "p"], "q"], ["r", "s
+"]]]], ["t", ["u", "v"]] ], [["w", ["x", "y"]], "z"] ];
$tree = [ [ [[[[["alpha", "bravo"], "charlie"], ["delta", "echo"]], [[
+["foxtrot", "golf"], "hotel"], [["indigo", "juliet"], ["kilo", ["lima
+", "mike"]]]]], ["november", [[["oscar", "papa"], "quebec"], ["romeo"
+, "sierra"]]]], ["tango", ["uniform", "victor"]] ], [["whiskey", ["xr
+ay", "yankee"]], "zulu"] ];
print tree( $tree );
sub half { ' ' x ( length(shift) >> 1 ) }
sub tree
{
my $tree = shift;
ref $tree or return "$tree\n" =~ s/ +/ /gr; # horizontal word
ref $tree or return $tree =~ s/./$&\n/gr; # vertical word
my ($padl, $padr) = map $_->[0] =~ tr// /cr, # pads
my ($left, $right) = map [ tree($_) =~ /.+/g ], @$tree;
use List::AllUtils qw( pairwise );
local $_ = join '', pairwise # paste two blocks side by side
{ "@{[($a // $padl)]} @{[($b // $padr)]}\n" } @$left, @$right;
return s{^(?=( *)(\S.*?) {2,}(\S.*?)( *\n))}{
my $span = ' ' x ($+[3] - $-[2] - 2 - length half($2) . half($3));
"$1 " . half($2) . $span =~ tr/ /_/r . half($3) . " $4"
. $1 . half($2) . "/$span\\" . half($3) . $4
}er;
}
Outputs:
+ ____________________________
+_______________________________________
+ /
+ \
+ ________________________________________________________________
+_______ ______________
+ /
+ \ / \
_____________________________
+______________________________________
+ ___________ __________ zulu
/
+ \
+ / \ / \
_______________________________________
+ _______________________ t
+ango _______ whiskey _____
/ \
+ / \
+ / \ / \
_______________ _____________________
+__ november _______________
+ uniform victor xray yankee
/ \ /
+ \ / \
+
__________ _____ _________ ____
+__________ _________ ______
+
/ \ / \ / \ /
+ \ / \ / \
+
______ charlie delta echo ______ hotel ______
+ _______ _____ quebec romeo sierra
+
/ \ / \ / \
+ / \ / \
+
alpha bravo foxtrot golf indigo juli
+et kilo ____ oscar papa
+
+ / \
+
+ lima mike
By commenting out the "horizontal word" line it produces:
________________________
+_
/
+ \
____________________________ _
+_____
/ \ /
+ \
___________________________ ___ ___
+ z
/ \ / \ /
+\ u
________________ _________ t __ w
+__ l
/ \ / \ a / \ h /
+ \ u
_____ _________ n _____ n u v i x
+ y
/ \ / \ o / \ g n i s r
+ a
___ __ ___ _____ v ___ __ o i c k a
+ n
/ \ / \ / \ / \ e / \ / \ f t e y
+ k
__ c d e __ h __ ___ m __ q r s o o y
+ e
/ \ h e c / \ o / \ / \ b / \ u o i r r
+ e
a b a l h f g t i j k __ e o p e m e m
+
l r r t o o o e n u i / \ r s a b e r
+
p a l a x l l d l l l m c p e o r
+
h v i t f i i o i i a a c a
+
a o e r g e m k r
+
o o t a e
+
t
| [reply] [d/l] [select] |
Re: Challenge: Dumping trees.
by brx (Pilgrim) on Nov 07, 2012 at 20:38 UTC
|
use strict;
my $sp = 1;
my $tree = [
[
[[[[["alpha", "bravo"], "charlie"], ["delta", "echo"]], [[["fo
+xtrot", "golf"], "hotel"], [["indigo", "juliet"], ["kilo", ["lima", "
+mike"]]]]],
["november", [[["oscar", "papa"], "quebec"], ["romeo", "sierra
+"]]]], ["tango", ["uniform", "victor"]]
],
[["whiskey", ["xray", "yankee"]], "zulu"]
];
my $lowerline = 0;
my $nodecount =0;
sub scantree {
my ($node,$level) = @_;
if (ref($node)) {
$level++;
scantree($_,$level) for (@$node);
} else {
$nodecount++;
my $ground = $level + length($node);
$lowerline = $ground if ($ground > $lowerline);
}
}
scantree($tree,0); # get number of columns and lines ($nodecount(* $sp
+) and $lowerline)
my @output = (" " x ((1+$sp)*$nodecount)) x ($lowerline+1);
$nodecount = 0; #reset
sub show {
my ($node,$level,$rl) = @_;
if (ref($node)) {
my $left=0; #0 is right // 1 is left
my @po;
for my $n (@$node) {
$po[$left] = show($n,$level+1,$left);
$left++;
}
# ____
# /size\
my $size = $po[1]-$po[0]-1;
substr($output[$level] , $po[0]+1, $size, "_" x $size);
substr($output[$level+1], $po[0] , 1 , "/");
substr($output[$level+1], $po[1] , 1 , "\\");
return($po[1-$rl]); #child return "hook" position to parent
} else {
$nodecount++;
my $p = ($nodecount-1)*($sp+1);
for my $l (1 .. length($node)) {
substr($output[$level+$l], $p+$sp, 1, substr($node,$l-1,1)
+); #write $node vertically
}
return ($p+$sp); # child returns his position to parent
}
}
show($tree,0,0);
my $out = join "\n",@output;
print "$out\n";
__END__
#lowcost new view :
my $col = length (($out=~/.(.*)/)[0]);
my $numlines = $out=~ tr/\n//;
for my $x (0 .. $col) {
for my $y (0 .. $numlines) {
my $ch = substr($out,$x+$y*($col+2),1);
$ch =~ tr/_/|/;
print $ch;
}
print "\n";
}
__DATA__
$sp=1
_______
___________/ \___
___________/ \_ _/ \
_______/ \_____ / \_ / \_ z
_/ \___ / \_ t / \ w / \ u
_/ \_ _/ \_ n _/ \_ a u v h x y l
_/ \ / \ _/ \ _/ \_ o _/ \ / \ n n i i r a u
/ \ c d e / \ h / \ / \_ v / \ q r s g i c s a n
a b h e c f g o i j k / \ e o p u o i o f t k y k
l r a l h o o t n u i l m m s a e m e o o e e
p a r t o x l e d l l i i b c p b e r r r y e
h v l a t f l i i o m k e a a e o r m
a o i r g e a e r r c a
e o o t
t
-----
$sp=2
__________
+_
_________________/
+ \_____
_________________/ \__ _
+_/ \
___________/ \________ / \__ /
+ \__ z
__/ \_____ / \__ t / \ w
+ / \ u
__/ \__ __/ \__ n __/ \__ a u v h
+ x y l
__/ \ / \ __/ \ __/ \__ o __/ \ / \ n n i i
+ r a u
/ \ c d e / \ h / \ / \__ v / \ q r s g i c s
+ a n
a b h e c f g o i j k / \ e o p u o i o f t k
+ y k
l r a l h o o t n u i l m m s a e m e o o e
+ e
p a r t o x l e d l l i i b c p b e r r r y
+ e
h v l a t f l i i o m k e a a e o r m
a o i r g e a e r r c a
e o o t
t
-----
$sp=3
+ _______________
______________
+_________/ \_______
_______________________/
+ \___ ___/ \
_______________/ \___________
+ / \___ / \___ z
___/ \_______ / \__
+_ t / \ w / \ u
___/ \___ ___/ \___ n ___/
+ \___ a u v h x y l
___/ \ / \ ___/ \ ___/ \___ o ___/ \
+ / \ n n i i r a u
/ \ c d e / \ h / \ / \___ v / \ q
+ r s g i c s a n
a b h e c f g o i j k / \ e o p u
+ o i o f t k y k
l r a l h o o t n u i l m m s a e
+ m e o o e e
p a r t o x l e d l l i i b c p b
+ e r r r y e
h v l a t f l i i o m k e a a e
+ o r m
a o i r g e a e r r c
+ a
e o o t
t
-----
$sp=0
___
_____/ \_
_____/ \ / \
___/ \__ /\ /\ z
/ \_ / \ t/\w/\u
/\ / \ n /\ auvhxyl
/\/\ /\ /\ o /\/\nniirau
/\cde/\h/\/\ v/\qrsgicsan
abhecfgoijk/\eopuoioftkyk
lralhootnuilmmsaeme ooe e
partoxledlliibcpber rry e
hvla tfliiomkeaaeor m
aoi r ge aerr c a
e o ot
t
----
lowcost new view ($sp=1)
/alpha
|
/\bravo
|
/\charlie
|
/\/delta
| |
| \echo
|
| /foxtrot
| |
| /\golf
| |
/\/\hotel
| |
| | /indigo
| | |
| \/\juliet
| |
| \/kilo
| |
| \/lima
| |
| \mike
|
/\/november
| |
| | /oscar
| | |
| | /\papa
| | |
| \/\quebec
| |
| \/romeo
| |
| \sierra
|
/\/tango
| |
| \/uniform
| |
| \victor
|
| /whiskey
| |
\/\/xray
| |
| \yankee
|
\zulu
English is not my mother tongue.
Les tongues de ma mère sont "made in France".
| [reply] [d/l] |