Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Dumping trees to a console.

by BrowserUk (Pope)
on Oct 15, 2012 at 14:11 UTC ( #999091=CUFP: print w/replies, xml ) Need Help??

Dumping trees to a terminal in a compact, readable form is an invaluable aid to developing and debugging tree-based algorithms. The following demonstrates a mechanism for doing this for array-based binary trees:

#! perl -slw use strict; use List::Util qw[ max ]; our $N; use enum qw[ LEFT RIGHT ]; sub _traverse { my( $code, $tree, $d, $w ) = @_; ref $tree->[LEFT] and $w = _traverse( $code, $tree->[LEFT], $d+1, $w ) or $code->( ++$w, $d, $tree->[LEFT] ); $code->( ++$w, $d,'^' ); ref $tree->[RIGHT] and $w = _traverse( $code, $tree->[RIGHT], $d+1, $w ) or $code->( ++$w, $d, $tree->[RIGHT] ); return $w; } sub traverse(&$) { _traverse( @_, 0, 0 ); } use enum qw[ WIDTH DEPTH NAME ]; sub dumpTree { my $tree = shift; my @g; traverse{ push @g, [ @_ ]; } $tree; my $width = max( map $_->[WIDTH], @g ); my $depth = max( map $_->[DEPTH], @g ); my @graph = map ' ' x $width, 0 .. $depth; substr $graph[ $_->[DEPTH] ], $_->[WIDTH], 1, substr($_->[NAME],0, +1) for @g; unshift @graph, (' ' x $width) x 2; for my $i ( reverse 0 .. $#graph ) { substr( $graph[$i-1], $-[1], $+[1]-$-[1], '/' . ' ' x (length( +$1)-2) . '\\' ), substr( $graph[ $i ], $-[2], 1, ' ' ) while $graph[ $i ] =~ m[(\S\s*(\^)\s*\S)]g; } my $n; for my $i ( reverse 0 .. $#graph ) { $n = $+[1]-$-[1], substr( $graph[ $i-1 ], $-[1]+1, $n-2, '_' x ($n-2)) while $graph[ $i ] =~ m[(/\s+\\)]g; } print for @graph, ''; return unless $N; my @names = map[ split '', reverse ], grep !/\^/, map $_->[NAME], +@g; print for map{ join( ' ', '', map pop @$_//' ', @names ) } 0 .. max( map scalar @$_, @names ); } my @a = qw[ alpha bravo charlie delta echo foxtrot golf hotel indigo juliet kilo mike november oscar papa quebec romeo sierra tango uniform victor whiskey xray yankee zulu ]; our $S //= 0; srand $S if $S; my $r; $r = int( rand $#a ), splice @a, $r, 2, [ @a[ $r, $r+1 ]] while @a > 1 +; @a = @{ $a[0] }; dumpTree( \@a );

A couple of examples:

C:\test>genBinTree -S=1 ___________ ___________/ \___ _______/ \_ _/ \ _____/ \_ _/ \_ _/ \_ z _/ \_ _/ \_ _/ \ / \ _/ \ / \ _/ \_ _/ \ _/ \ / \ _/ \ r s t / \ w x y _/ \ / \ / \ h / \ k m n / \ q u v / \ c d e f g i j o p a b C:\test>genBinTree -S=1 -N ___________ ___________/ \___ _______/ \_ _/ \ _____/ \_ _/ \_ _/ \_ z _/ \_ _/ \_ _/ \ / \ _/ \ / \ _/ \_ _/ \ _/ \ / \ _/ \ r s t / \ w x y _/ \ / \ / \ h / \ k m n / \ q u v / \ c d e f g i j o p a b a b c d e f g h i j k m n o p q r s t u v w x y z l r h e c o o o n u i i o s a u o i a n i h r a u p a a l h x l t d l l k v c p e m e n i c i a n l h v r t o t f e i i o e e a a b e r g f t s y k u a o l a r l g e m r e o r o o o k e i o o t b c a r r e e e t e m y r C:\test>genBinTree -S=1234567890123456789 _____________________ _______/ \_ _______/ \___________ _/ \___ _/ \ _____/ \ _/ \ / \_ / \___ f / \_________ q _/ \ v w _/ \ a / \_ g ___/ \ _/ \ u / \ z b _/ \ / \_____ p / \ t x y / \ e h _/ \_ r s c d / \_ _/ \ i / \ / \ o j k m n C:\test>genBinTree -S=123456789012345678 _______ ___/ \_ _/ \_ _/ \_______ / \_ / \_ / \ / \_________ a / \ d / \ g h i _/ \___________ b c e f _/ \ ___/ \_ _/ \ n _/ \ _____/ \ / \ m _/ \_ s ___/ \ z j k / \ / \ / \_ y o p q r t _/ \_ / \ / \ u v w x

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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://999091]
Approved by Corion
help
Chatterbox?
[dazz]: Hi I have grabbed an image from an IP camera with Image::Grab. I then want to pass that image object to a subroutine where I do a read-only test on the image with Image:Magick.
[dazz]: How do I pass an image object to a subroutine and then apply a Image::Magick a read-only method to the image object???
[dazz]: Also, I want to use Image::Magick to annotate and composite (not in a sub). How do I take a Image::Grab object and apply Image::Magick write methods to it??
[dazz]: At present, I am saving the Image::Grab image to disk, then creating a new Image::Magick object that reads the disk file.

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (6)
As of 2017-03-27 07:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Should Pluto Get Its Planethood Back?



    Results (317 votes). Check out past polls.