Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Challenge: Dumping trees.

by BrowserUk (Pope)
on Oct 13, 2012 at 00:13 UTC ( #998803=perlmeditation: print w/ replies, xml ) Need Help??

I've historically found writing code for manipulating tree structures awkward; and a primary reason for it is that when things go wrong, visualising why is hampered by the lack of a mechanism for creating convenient, compact and readable dumps of the structures.

Data::Dump, Data::Dumper et al. do a perfectly fine job of dumping the structure in terms of the arrays (or hashes) that hold the tree, but are pretty useless when if comes to visualising the tree structure itself: levels; depth; width; changes from one iteration to the next etc. And I usually find myself resorting to manually manipulating a dump in order to work out what is going on.

For example, a not very complicated, array-based binary tree might get dumped like this:

[ [ [[[[["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"] ]

Try working out how deep; or wide; or which nodes are at the same level; from that. Not to mention seeing what changed between this dump and the previous -- when (for example) re-balancing the tree.

With hand manipulating this you can come up with something like:

[0 [1 . [2 . . [3 . . . [4 . . . . [5 . . . . . [6 . . . . . . "a", . . . . . . ."b" . . . . . ], . . . . . "c" . . . . ], . . . . [5 . . . . . "d", . . . . . "e" . . . . ] . . . ], . . . [4 . . . . [5 . . . . . [6 . . . . . . "f", . . . . . . "g" . . . . . ], . . . . . "h" . . . . ], . . . . [5 . . . . . [6 . . . . . . "i", . . . . . . "j" . . . . . ], . . . . . [6 . . . . . . "k", . . . . . . [7 . . . . . . . "l", . . . . . . . "m" . . . . . . ] . . . . . ] . . . . ] . . . ], . . ], . . [3 . . . "n", . . . [4 . . . . [5 . . . . . [6 . . . . . . "o", . . . . . . "p" . . . . . ], . . . . . "q" . . . . ], . . . . [5 . . . . . "r", . . . . . "s" . . . . ] . . . ] . . ], . ], . [2 . . "t", . . [3 . . . "u", . . . "v" . . ] . ], ], [1 . [2 . . "w", . . [ . . . "x", . . . "y" . . ] . ], . "z" ], ]

Which allows those questions to be answered, but it is hardly concise or convenient; and makes comparing multiple iterations of changes very awkward.

The same tree can be represented this way:

___________/\_________ +___ ________________/\____________ +__/\_ _____________/\______________ /\ / +\ \ ________/\________ ___/\___ / \ / + \ 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

which is far nicer.

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.)


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

Comment on Challenge: Dumping trees.
Select or Download Code
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

    #!/usr/bin/perl -- use strict; use warnings; use Data::Dump; use Data::Rmap qw/ rmap_array /; use Tree::Visualize; use Tree::Simple; use Tree::Simple::Visitor::FromNestedArray; my $root = [ [ [ [ [[["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"], ]; dd $root; rmap_array { my( $key, @rest ) = @$_; my @new; for my $one ( $key, @rest ){ push @new, '' if ref $one; push @new, $one ; } $_ = \@new; return; } $root; dd $root; my $visitor = Tree::Simple::Visitor::FromNestedArray->new(); $visitor->setArrayTree( $root ); my $tree = Tree::Simple->new(Tree::Simple->ROOT); $tree->accept($visitor); print Tree::Visualize->new( $tree, 'ASCII', 'TopDown', #~ 'Diagonal', ## fail to throw exception #~ 'LeftSide', ## fail to throw exception #~ 'RightSide', ## fail to throw exception )->draw(), "\n\n";

    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

Re: Challenge: Dumping trees.
by jmcnamara (Monsignor) on Oct 13, 2012 at 09:13 UTC

    One option may be Data::Dumper::Perltidy:

    #!/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:

    $VAR1 = [ [ [ [ [ [ [ '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' ] ];

    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.

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.

Re: Challenge: Dumping trees.
by Anonymous Monk on Oct 13, 2012 at 15:42 UTC

    Done! Adapted from http://hectorcorrea.com/Blog/Drawing-a-Binary-Tree-in-Ruby, where descendents are called children :)

    #!/usr/bin/perl -- use strict; use warnings; use Data::Dump; my $root = [ [ [ [ [[["a", "b"], "c"], ["d", "e"]], [[["f", "g"], "h"], [["i", "j"], ["k", ["l", "m"]]]], #~ [[["a", "b"], "cc"], ["dd", "ee"]], #~ [[["a", "b"], "ccc"], ["ddd", "eee"]], ], ["n", [[["o", "p"], "q"], ["r", "s"]]], ], ["t", ["u", "v"]], ], [["w", ["x", "y"]], "z"], ]; my $leftstart = 1000; my @lines; my @rows; my $leftestmost = 0; my $rightestmost = 0; Fudgy( $root, 0, 0, sub { my($node, $x,$y,$px,$py, $leftoright ) = @_; $leftestmost = $x if $x < 0 and $leftestmost > $x; $rightestmost = $x if $x > 0 and $rightestmost < $x; my $text = $node; if( ref $node ){ my( $left, $right ) = @$node; $text = ''; $text .= '/' if $left; $text .= '\\' if $right; } my $xpd = abs(abs($px)-abs($x)); $x = $leftstart + $x; push @{ $rows[ $y ] } , [ $x, $text , $px, $py , $xpd ]; my $lll = $lines[ $y ]; $lll ||= ' ' x ( 2 * $leftstart );; substr $lll, $x, length($text), $text; $lines[ $y ] = $lll; if( $y > 0 ){ my $off = $x + 1; my $rep = '_' x ( $xpd - 1 ); my $lline = $lines[ $y - 1]; if( $leftoright > 0 ){ $off -= length( $rep ); } substr $lline, $off, length($rep),$rep; $lines[ $y -1 ] = $lline; } } ); dd \@rows; s/\s+$// for @lines; $leftestmost = $leftstart + $leftestmost ; s/^\s{$leftestmost}// for @lines; print join "\n", @lines; sub Fudgy { my( $node , $x, $y, $subref ) = @_; return if not @$node; my( $left, $right ) = @$node; $subref->( $node, $x, $y , $x, $y ); $left and draw_left( $left, $x , $y , $subref ); $right and draw_right($right, $x , $y , $subref ); } sub draw_left { my( $node , $px, $py, $subref ) = @_; my $count = 0; my( $left, $right ) = eval { @$node }; $right and $count = 1 + descendents_count( $right ); my $x = $px - $count - 1; my $y = $py + 1; $subref->( $node, $x, $y, $px, $py , -1 ); $left and draw_left( $left , $x, $y, $subref ); $right and draw_right( $right, $x, $y, $subref ); } sub children_count { return 1 if not ref $_[0]; return int @{ $_[0] }; } sub descendents_count { my( $node ) = @_; my( $left, $right ) = eval { @$node }; my $count = 0; $left and $count += 1 + descendents_count( $left ); $right and $count += 1 + descendents_count( $right ); return $count; } sub draw_right { my( $node , $px, $py, $subref ) = @_; my $count = 0; my( $left, $right ) = eval { @$node }; $right and $count = 1 + descendents_count( $left ); my $x = $px + $count + 1; my $y = $py + 1; $subref->( $node, $x, $y, $px, $py , +1 ); $left and draw_left( $left , $x, $y, $subref ); $right and draw_right( $right, $x, $y, $subref ); } __END__ __END__ __END__ __END__
    _____/\_____ ___________/\_ ___/\ _______________/\_ /\_ /\_ 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 :)

      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

      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

        I also finally succeeded

        neat :) it really is much easier on the eyes

        Upon further testing, the anomalies

        Hmm, weird. Using your tree generator

        from genBiaryTree
        my $root = do { our $S //= 0; srand $S if $S; 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 = @{ $a[0] }; \@a; };
        And running
        Fudgy >anomaly.txt Fudgy -S=2 >>anomaly.txt Fudgy -S=3 >>anomaly.txt Fudgy -S=4 >>anomaly.txt Fudgy -S=40 >>anomaly.txt Fudgy -S=400 >>anomaly.txt Fudgy -S=400000 >>anomaly.txt Fudgy -S=99999400000 >>anomaly.txt notepad anomaly.txt

        I was not able to reproduce the anomalies, I get

        _________________/\_____________________________________________ +____ _/\_____ __ +___/\___________________________________ _/\ _/\_______ ___________________________/\_ +__ _/\_________ /\ c _/\ ___/\_ _________/\_____ +_/\ _______________________/\ _/\ a b /\ f _/\_ /\ _/\_______ _/\_______ / +\ B ___/\_________________ T _____/\ Z d e /\ /\ k l _/\ _/\ _/\ ___/\_________ 9 +A ___/\_ _____/\_ /\_ Y g h i j /\ o ___/\ t /\ w _/\_ _______/\_ + /\_ /\ ___/\___ /\_ U /\_ m n /\_ s u v /\ /\ /\___ /\ + C /\ F G ___/\_ _/\ Q /\ V /\ p /\ x y z 1 2 _/\_ 7 8 + D E _/\_ /\ /\ P R S W X q r /\ /\ + /\ /\ L M N O 3 4 5 6 + H I J K _______/\_____________________________________________________ +________________________________________________ _/\___ + _______________________________/\_ _/\ _/\_ ______________________ +_______________/\___ /\ _/\ d /\ /\ _____________/\_____________________ +______________ _/\_________________________ Y Z /\ c e f g h ___________/\_______ + _______/\ /\ _________________/\ a b ___/\_____ _/\___ ________________ +_____/\___ H I J _____/\_______________ X /\_ _/\___ _/\ _/\ ___/\_ + _/\_ /\_ ___________/\ i /\ _/\ _/\ _/\ u /\ x /\_ /\_ + /\ /\ K /\_ _/\___ W j k /\ n /\ q /\ t v w y /\ 2 /\_________ + D E F G L /\ /\ _/\_____ l m o p r s z 1 3 _______/\_ +__ M N O P /\ _/\ /\_ +_/\_ Q R _/\ V 4 /\___ / +\ /\ /\ U 5 _/\ 9 +A B C S T /\ 8 6 7 ______________________________ +_________________________________________________/\ ___________________________________/\_____________________________ +______________ Z _/\___________________________ ____________________ +_____________/\_______________________________ /\ _______/\_ _____/\_________ + _______________/\_ a b _________/\_ /\_ _/\_ _____/\_________ +__ ___________/\_ /\ ___/\_______ /\___ q /\_ /\ /\_ _/\_ ______ +_/\_______ _/\_________ /\_________ X Y ___/\_ _____/\ m _/\ r /\ u v w /\ /\ /\_ _/\___ + _/\_ /\ _/\ P _/\_ /\_ /\ /\_ l /\ p s t x y z 1 2 /\ /\ _/\_ + ___/\ /\ H I _/\ O ___/\ /\ c /\ f g h /\_ n o 3 4 5 6 /\ / +\ /\_ E F G _/\ N _/\_ U V W d e i /\ 7 8 9 +A B /\ _/\ M /\ /\ j k + C D /\ L Q R S T + J K ________________________________________________________________ +_________/\_____________________________________ _/\___________________________ + ___________________________________/\_ _/\ _____/\_______________ + /\_______________________________ /\ /\ c _/\_ ___________/\___________________ + F ___________________________/\_ Y Z a b _______/\ /\_ _/\_________ _______________/ +\_ _/\_________________________ /\ ___/\_ n o /\ /\ _/\ _/\_ + /\_ /\ ___________/\ W X ___/\_ /\_ p q r s ___/\ y /\ /\_ +A /\_ G H _____/\_____ V _/\_ /\ j /\_ _/\_ x z 1 2 /\___ + B /\_ _/\_ _/\___ /\ /\ h i k /\ /\ /\ 3 _/\___ + C /\ ___/\ /\_ _/\ _/\ d e f g l m t u v w /\ _/\_ + D E /\_ L M /\ /\ R /\ U 4 5 /\ /\ + I /\ N O P Q S T 6 7 8 9 + J K ___________/\_______________________________________ ___/\_______ _____________________________/ +\___ _/\_ ___/\_ ___/\_________________________ + _/\___________ _____/\ /\ _/\_ /\ ___/\_ _____________________/\_ + /\ _____/\___ _/\___ g h i /\ /\ n o /\_ /\ _/\_________________ /\ +A B ___/\___ _/\___________ _/\ _/\ j k l m p /\ s t /\ ___________/\_ 8 9 + /\_ _/\ /\ _______/\_________ /\ c /\ f q r u v _/\_________ /\ + C /\ /\ H I J _/\___ ___/\___ a b d e _/\ _____/\ 6 7 + D E F G /\ _/\_ ___/\_ _/\_ /\ y _/\_ 5 + K L /\ /\ /\_ /\ /\ /\_ w x /\ /\_ + M N O P Q /\ T U V W X /\ z 1 2 /\ + R S Y Z 3 4 _________________________/\___________________________ +__________________________ _____________/\_ + _____________/\_ /\_______ /\_____________________ ____ +___________/\_ /\_____________ a _/\_ i _____________/\ ___/\___ +____ /\_____ N _________/\___ ___/\ /\_ ___/\___ u ___________/\_ +___/\___ G ___/\_ _/\_ _/\_ /\_ e f /\ _/\_ _/\_____ _____/\___ /\ _/ +\_ _/\_ /\_ /\_ /\ /\_ /\ /\_ b /\ g h /\ /\ /\ _/\_ /\_ _/\_____ 6 7 /\ + /\ /\ /\ H /\ K /\ O P Q /\___ V W X /\ c d j k l m n o _/\ /\ v /\_ /\ _/\ 8 9 +A B C D E F I J L M R _/\ Y Z /\ r s t w /\ z 1 _/\ 5 + /\ U p q x y /\ 4 + S T 2 3 ________________ +___________________/\_________________ _/\_______________ +________ _________/\___ _______________________________________________/\ + ___/\___ _____/\___ _/\___ _/\_____________________________________ 1 ____________ +___/\_ _/\_____ /\___ _/\___ /\ _/\_ /\ _____________/\_______ _/\___ + /\ /\ _/\ K _/\ /\ _/\ T U /\ /\_ a b _______/\_ _/\ /\ _/\___ + C D E F _/\ J /\ N O P /\ S V W X /\ _______/\_____ /\___ _/\ z 2 3 /\ _/\___ + /\ I L M Q R Y Z ___/\_ ___/\ o _/\_____ _/\ y 4 5 /\ _/ +\_ G H _/\_ /\_ /\_ n /\ _/\ /\ x 6 7 /\ + /\ /\ /\ g /\_ k /\ p q _/\ u v w 8 9 +A B c d e f h /\ l m /\ t i j r s _______/\_____________________ +______________________ ___________________________________/\_____ ______________ +_____________________/\___________ _/\___________________ ___/\ _____/\_____________ +____________________ _______/\_ /\ _______/\_________ /\_ x /\___ ____________ +___________________/\ _/\___ /\_ a b _______/\_ _______/\___ u /\ y _/\ /\___ + K /\ _/\_ R /\___ _/\___ /\_ /\_ _/\ v w /\ 2 3 _/\_ + L M /\ /\ S _/\_______ /\ _/\_ i /\_ m /\_ /\ t z 1 /\ /\_____ +__________ N O P Q /\ _/\ c d /\ /\ j /\ n /\_ r s 4 5 6 +_________/\___ T U ___/\ Z e f g h k l o /\ _/ +\_ _/\___ /\_ Y p q _/\ + /\_____ /\ _/\ V /\ /\ 9 +A ___/\ F G /\ J W X 7 8 + /\_ E H I + B /\ + C D
Re: Challenge: Dumping trees.
by remiah (Hermit) on Oct 14, 2012 at 06:25 UTC

    Hello BrowserUK.

    I know this is not terminal one but html output is handy for me.

    #!/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; /*&#30333;*/ } 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.

Re: Challenge: Dumping trees.
by brx (Pilgrim) on Nov 07, 2012 at 20:38 UTC

    I know it's a little bit late...

    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".
Re: Challenge: Dumping trees.
by hdb (Parson) 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

      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.

        For that you require a left/right flag to indicate which side of a subtree you are in. The logic is probably even simpler:

        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.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (10)
As of 2014-08-28 15:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (263 votes), past polls