use strict; use warnings; use constant { LEFT => 0, RIGHT => 1 }; sub prepare { my( $tree, $w, $lr, $level, $col, $canvas, $chars ) = @_; if( ref($tree) ) { my( $lcol, $rcol ) = map { $$col += $w*$_; prepare( $tree->[$_], $w, $_, $level+1, $col, $canvas, $chars ) } LEFT, RIGHT; $canvas->[$level ]->[$lcol] = $$chars[LEFT]; $canvas->[$level-1]->[$_ ] = '_' for $lcol+1..$rcol-1; $canvas->[$level ]->[$rcol] = $$chars[RIGHT]; return $lr ? $lcol : $rcol; } else { $canvas->[$level++]->[$$col] = $_ for split //, $tree; return $$col; } } sub dumpTree { my ($col, @canvas ) = (1); my $width = $_[1] > 0 ? 1+$_[1] : 1; my $chars = $_[2] ? [ '|', '|' ] : [ '/', '\\' ]; prepare( $_[0], $width, RIGHT, 1, \$col, \@canvas, $chars ); return join( '', map { join( '', map { $_ // ' ' } @$_, "\n" ) } @canvas ); } sub randomTree { my @t = @_; my $r; $r = int( rand $#t ), splice @t, $r, 2, [ @t[ $r, $r+1 ]] while @t > 1; return $t[0]; } my @t1 = ( 'a'..'z' ); my @t2 = qw( Alpha Beta Gamma Delta Epsilon Zeta Eta Theta Iota Kappa Lambda Mu Nu Xi Omicron Pi Rho Sigma Tau Upsilon Phi Chi Psi Omega); print dumpTree( randomTree( @t1 ), 1 ); print dumpTree( randomTree( @t2 ), 3, 1 );