Recently, I noticed an interesting question on StackOverflow. It reminded me of my solution to the task "Visualize a Tree" on Rosetta Code.

I tried to solve the task. If you want to see me solving the task, watch a YouTube screencast. If you just want to see the solution (almost identical to the one in the video), check below.

لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

Replies are listed 'Best First'.
Re: Parsing a Tree to a Table.
by oiskuu (Hermit) on Dec 05, 2013 at 16:20 UTC

Why is the question on hold at SO? Looks like someones homework alright, but to reverse tree visualisation is a valid problem and potentially useful to someone. Anyway, I hoped there would be some extra neat solution, then spent ten minutes correcting one silly mistake after another. Almost a one-liner:

```#! /usr/bin/perl -ln
/\|\s*\$/ or /.*?--(-?)|/, splice(@a,\$+/3), \$1 ? print join "\t", @a
+[0..2], \$' : push @a, \$';

If I understand it correctly, it only works for the trees of depth 4, right?
لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Well, it prints as it goes, so prior knowledge of max depth is needed. (Adding this as option is trivial.)

Note that the problem description shows four output columns, and mentions large data.

Re: Parsing a Tree to a Table.
by BrowserUk (Pope) on Dec 10, 2013 at 10:21 UTC

For fun.

```#! perl -slw
use strict;

my @a;
my \$last = 0;

while( <DATA> ) {
m[(^[^A-Z]+)?([A-Z]+)] or next;
my \$l = length( \$1//'' );
if( @a and \$l <= \$last ) {
print join "\t", @a;
pop @a for 1 .. (\$last-\$l+3)/3;
}
push @a, \$2;
\$last = \$l;
}
print join "\t", @a;

__DATA__
A
|
|--B
|  |
|  |--C
|     |
|     |---PQR
|     |---XYZ
|--D
|  |
|  |---LMN
|---XYZ

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.
Re: Parsing a Tree to a Table.
by Discipulus (Abbot) on Dec 05, 2013 at 10:15 UTC
hello,
about the rosetta code: it says nor the tree or the output are important. For me a tree is always an HoH and this remember me an ancient piece of code i wrote long time ago (little refurbished to run under strict... now i'm little wiser ;=) ).
```use strict;
use warnings;

my %h1=('qwqw' => {'qw' => 'qww','df' => 'dfff','C1' => {'A2' => 'a2',
+'B2' => 'b2','C2' => 'c2END'}},);
my %h2=(
'AAA' => 'aaa',
'BBB' => 'bbb',
'CCC' => {'A1' => 'a1','B1' => 'b1','C1' => {'A2' => 'a2','B2' => 'b2'
+,'C2' => 'c2END'}},
'DDD' => 'ddd',
'EEE' => \%h1,
'FFF' => 'sdsfsds',
);

&ddump(\%h2);

sub ddump
{
my \$ref  = shift;
my \$deep = shift||0;
foreach my \$k (sort keys %{\$ref})     {
if (ref( \${\$ref}{\$k}))  {print "\t" x \$deep."\$k =>\n"; &dd
+ump (\${\$ref}{\$k}, (\$deep+1))}
else {print "\t" x (\$deep)."\$k => \${\$ref}{\$k}\n";}
}
}

PS I noticed something I do not understand: if you change \$deep+1 whit ++\$deep the beahaviur change: why? in docs i learn:
```Note that just as in C, Perl doesn't define when the variable is incremented or decremented. You just know it will be      done sometime before or after the value is returned. This also means that modifying a variable twice in the same statement will lead to undefined behavior.

```
Is this the case?
L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

The behaviour here has nothing to do with when the increment operation is applied. \$deep + 1 evaluates to 1 more than the current value of \$deep, but leaves that value unchanged. ++\$deep (or \$deep++) changes the variable’s value by incrementing it, so that on the next iteration of the foreach loop, \$deep is larger (by 1) than it was before. ++\$deep is equivalent to \$deep += 1 — the latter form makes the change to the variable explicit via the presence of an assignment operator.

Hope that helps,

 Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

OMG what a stupid's moment passed to me!!
thanks
L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Re: Parsing a Tree to a Table.
by hdb (Monsignor) on Dec 10, 2013 at 08:30 UTC

Very nice puzzle. Here is my solution:

```use warnings;
use strict;

my @path;
my @data;
my \$size = 0;
while(<DATA>) {
chomp;
\$path            = \$1 if /^([^|]*)\$/;
\$path[length(\$1)/3] = \$2 if /^(.*\|--)([^-]+)\$/;
if( /^(.*\|--)-([^-]+)\$/ ) {
\$#path = length(\$1)/3 - 1;
push @data, [ @path, \$2 ];
\$size = @path if \$size < @path;
}
}
splice @\$_, -1, 0, ('')x(1+\$size-@\$_) for @data;
print join( "\t", @\$_ ),"\n" for @data;

__DATA__
A
|
|--B
|  |
|  |--C
|     |
|     |---PQR
|     |---XYZ
|--D
|  |
|  |---LMN
|---XYZ
Re: Parsing a Tree to a Table.
by Discipulus (Abbot) on Dec 10, 2013 at 11:13 UTC
just a convoluted tree prettyfication
```use warnings;
use strict;

my @tab;

while(my \$l = readline (*DATA) ) {
@{\$tab[\$.-1]}= split '',\$l ;
foreach my \$i (0..\$#{\$tab[\$.-1]})  {
unless (\$. == 1) { \${\$tab[\$.-1]}[\$i] =~ s/\|/\${\$tab[\$.-2]}[\$i
+]/g if defined \${\$tab[\$.-2]}[\$i]  }
}
}

foreach my \$row (@tab) {
print @{\$row};
}
__DATA__
A
|
|--B
|  |
|  |--C
|     |
|     |---PQR
|     |---XYZ
|--D
|  |
|  |---LMN
|---XYZ
X
|---000

cya
L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Re: Parsing a Tree to a Table.
by LanX (Cardinal) on Dec 10, 2013 at 14:26 UTC
As a side note @RosettaStone: Many languages just showed their Data::Dumper equivalent! :-|

my emphasize is on readability and flexibility for alternative formats, but YMMV! =)

```#!/usr/bin/perl
use warnings;
use strict;
use Data::Dump qw/pp/;
#use diagnostics;

use Test::More tests => 1;

my \$input = <<'__IN__';
A
|
|--B
|  |
|  |--C
|     |
|     |---PQR
|     |---XYZ
|--D
|  |
|  |---LMN
|---XYZ
__IN__

my \$expected = <<'__EXP__';
Column1    Column2    Column3    Column4
A    B    C    PQR
A    B    C    XYZ
A    D        LMN
A            XYZ
__EXP__

my (@path,@table);
my \$max=0;

for (split /\n/, \$input) {
#print ;
/^ (.*?) (---(\w\w\w))? \$ /x;

my \$leave = \$3;
my @track = split /  |--/, \$1;

die "parsing error \$_"
unless @track;

\$path[\$#track] = \$1
if (\$track[-1] =~ /(\w)/ );

#pp [@track], [@path], \$leave;

if (\$leave) {
push @table, [ @path[0..\$#track], \$leave ];
\$max = @track if @track >\$max;
}

}

pp \@table;

my \$out="";

\$out .= "Column\$_\t" for 1..\$max+1;
\$out .= "\n";
for (@table){
my \$width = @\$_-1;
\$out .= join "\t", @\$_[0..\$width-1];
\$out .= "\t"x(\$max-\$width+1);
\$out .= @\$_[\$width];
\$out .= "\n";
}

print \$out;

is(\$out,\$expected);

```1..1
[
["A", "B", "C", "PQR"],
["A", "B", "C", "XYZ"],
["A", "D", "LMN"],
["A", "XYZ"],
]
Column1    Column2    Column3    Column4
A    B    C    PQR
A    B    C    XYZ
A    D        LMN
A            XYZ