in reply to Challenge: Dumping trees.
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 :)
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: Challenge: Dumping trees.
by BrowserUk (Patriarch) on Oct 14, 2012 at 08:40 UTC | |
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.
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:
This:
Also, one possibility for handling node 'names' of more than 1 or 2 chars; though I'm not sure it really works as is?:
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] [d/l] [select] |
|
Re^2: Challenge: Dumping trees.
by BrowserUk (Patriarch) on Oct 15, 2012 at 14:16 UTC | |
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.
| [reply] |
by Anonymous Monk on Oct 15, 2012 at 17:14 UTC | |
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
And running
I was not able to reproduce the anomalies, I get
| [reply] [d/l] [select] |
by BrowserUk (Patriarch) on Oct 15, 2012 at 20:58 UTC | |
I was not able to reproduce the anomalies, Okay. At that point, I manually made the simplest correction to the raw tree that (I thought) would make it valid:
and re-ran the dumper. As you can see, it still produces the identical, malformed dump:
So then I fed that corrected tree to my dumper:
At this point, I'm kicking the ball into your court to decide if it is worth pursuing further? 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] [d/l] [select] |
by Anonymous Monk on Oct 15, 2012 at 22:03 UTC | |