bintree.pl

# bintree - binary tree demo program 
# adapted from "Perl Cookbook", Recipe 11.15
# converted to modern Perl 6 by SF & Carl Masak
use v6;

role Found { has Int $.found is rw }

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

enum TraversalMode <pre-order in-order post-order>;

say "Pre order:   { collect(%root, pre-order) }";
say "In order:    { collect(%root, in-order) }";
say "Post order:  { collect(%root, post-order) }";

while defined (my $sought = prompt('Search? ')) {
    if (my $node = search(%root, $sought)) {
        say "Found $sought at { $node.perl }: { $node<VALUE> }";
        say "(again!)" if $node<VALUE>.found > 1;
    }
    else {
        say "No $sought in tree";
    }
}

say "\nGoodbye!";

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

sub traverse(%tree, TraversalMode $method) {
    return unless %tree;
    given $method {
        when pre-order {
            traverse(%tree<LEFT>, $method);
            traverse(%tree<RIGHT>, $method);
            take %tree<VALUE>;
        }
        when in-order {
            traverse(%tree<LEFT>, $method);
            take %tree<VALUE>;
            traverse(%tree<RIGHT>, $method);
        }
        when post-order {
            take %tree<VALUE>;
            traverse(%tree<LEFT>, $method);
            traverse(%tree<RIGHT>, $method);
        }
    }
}

sub collect(%tree, TraversalMode $method) {
    gather {
        traverse(%tree, $method);
    }
}
     
sub search (%tree is rw, $value) {
    return unless %tree;
    return search(%tree{$value < %tree<VALUE> ?? "LEFT" !! "RIGHT"}, $value)
        unless %tree<VALUE> == $value;
    %tree<VALUE>.found++;
    return %tree;
}