Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Parsing a Tree to a Table.

by choroba (Cardinal)
on Dec 05, 2013 at 01:54 UTC ( [id://1065693]=perlmeditation: print w/replies, xml ) Need Help??

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,$+[0]/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 (Patriarch) 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 (Canon) 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[0] = $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 (Canon) 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 (Saint) 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

    Cheers Rolf

    ( addicted to the Perl Programming Language)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://1065693]
Approved by Athanasius
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chanting in the Monastery: (6)
As of 2024-03-19 03:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found