Thursday, February 4, 2010

Binary Tree, Almost Complete Script

So, I played around with the binary tree script a bit more after posting yesterday. It was mostly very straightforward once I figured out how to make it work with "is rw". Here's what I've got now:
# bintree - binary tree demo program 
# adapted from "Perl Cookbook", Recipe 11.15
# converted to modern Perl 6 by SF
use v6;

my %root;
for (1..1000).pick(20) {
insert(%root, $_);

enum TraversalMode <pre in post>;

print "Pre order: "; show(%root, TraversalMode::pre); print "\n";
print "In order: "; show(%root, TraversalMode::in); print "\n";
print "Post order: "; show(%root, TraversalMode::post); print "\n";

# $ARGS prompts("Search? ");

for @*ARGS {
if (my $node = search(%root, $_)) {
say "Found $_ at { $node.perl }: { $node<VALUE> }";
# say "(again!)" if $node<VALUE>.Found > 1;
else {
say "No $_ in tree";

sub insert(Hash $tree is rw, Int $val) {
unless $tree {
$tree<LEFT> =;
$tree<RIGHT> =;
$tree<VALUE> = $val ; # but Found(0);
if ($tree<VALUE> > $val) { insert($tree<LEFT>, $val) }
elsif ($tree<VALUE> < $val) { insert($tree<RIGHT>, $val) }
else { warn "dup insert of $val\n" }

sub show(%tree, $mode) {
return unless %tree;
show(%tree<LEFT>, $mode) unless $mode == TraversalMode::post;
show(%tree<RIGHT>,$mode) if $mode == TraversalMode::pre;
print %tree<VALUE>, " ";
show(%tree<LEFT>, $mode) if $mode == TraversalMode::post;
show(%tree<RIGHT>,$mode) unless $mode == TraversalMode::pre;

sub search ($tree is rw, $value) {
return unless $tree;
return search($tree{$value < $tree<VALUE> ?? "LEFT" !! "RIGHT"}, $value)
unless $tree<VALUE> == $value;
# $tree<VALUE> but Found($tree<VALUE>.Found+1);
return $tree;

Let me highlight the big differences between this and the Exegesis 2 version:

1) Using pick instead of rand. It's not shorter, but IMO pick is definitely more idiomatic. pick is also more correct, in some sense: the original code clearly did not want duplicate numbers, warning the user when they happened. With pick that never happens.

2) enum instead of trying to emulate the idea with is constant = (0..2).

3) Oh yes, using %root instead of $root.

4) Apparently $ARGS prompts("Search? "); was meant to create a prompt to get input from the user if there's nothing on the command line? I've no idea if that facility still exists in Perl 6, or was ever implemented in Rakudo.

5) Also skipped the Found role. I'm not sure how the old code expected it work without defining Found. I think they were trying to prove a point about roles, because the whole idea would be more easily implemented using another field in the hash.

6) In insert, instead of sticking undef in the left and right fields, I actually create empty Hash objects. As you can see in my last post, I originally created undefined Hash objects, but this worked better for me. In practice, it might be better to leave these out entirely until they are needed, but this matches the logic of the old version.

7) In show, I've converted it to use sub arguments rather than all that ugly @_ stuff. I've no idea why the original code didn't do that in the first place, unless it was to show that @_ still worked.

8) In search, I've changed it from a boolean logical expression to a simple ternary ?? !!.

I guess I should look at coding up a Found role, and then trying to use it correctly. Thought honestly, I'm more inclined to completely rewrite this as a binary tree class, which I think would do wonders for the code even as it wandered far away from the shape of the original.


  1. I am glad that you used Syntax::Highlight::Perl6 to highlight Perl 6 code :)

  2. Ahmad: any hints that you have for updating it to the latest would be greatly appreciated. :)