I’ve been doing the Perl Weekly
Challenges. The
latest
involved inverting a binary tree and finding unique prefixes.
You are given a full binary tree of any height.
Write a script to invert the tree, by mirroring the children of
every node, from left to right.
The input can be any sensible machine-readable binary tree format of
your choosing, and the output should be the same format.
Well then, I'll just use the format I wrote for last week's problem…
which also works on non-binary trees, which is handy.
my @tree=qw(1 .2 ..4 ..5 .3 ..6 ..7);
And the interpreter I wrote then too.
my %tree;
{
my @parent;
foreach my $index (0..$#tree) {
$tree[$index] =~ /^(\.*)(\d+)/;
my ($depth,$val)=(length($1),$2);
$tree{$index}{value}=$val;
if ($depth>0) {
push @{$tree{$parent[$depth-1]}{children}},$index;
}
$parent[$depth]=$index;
}
}
The reversal is trivial:
foreach my $k (keys %tree) {
if (exists $tree{$k}{children}) {
@{$tree{$k}{children}}=reverse @{$tree{$k}{children}};
}
}
Then it's just a recursion to print the thing in some sort of good order.
tdump(\%tree,0,0);
sub tdump {
my ($tree,$index,$depth)=@_;
print '.' x $depth,$tree->{$index}{value},"\n";
if (exists $tree->{$index}{children}) {
foreach my $c (@{$tree->{$index}{children}}) {
tdump($tree,$c,$depth+1);
}
}
}
BONUS
In addition to the above, you may wish to pretty-print your binary
tree in a human readable text-based format similar to the following:
1
/ \
3 2
/ \ / \
7 6 5 4
This is actually distinctly more fiddly. And here I do give up
generality and rely on the tree being both full and binary; there are
no leaf nodes at less than the maximum depth. I also rely on each tree
value being a single character.
my %d;
my @t=([0,0]);
while (@t) {
my $i=shift @t;
my ($index,$depth)=@{$i};
push @{$d{$depth}},$index;
if (exists $tree{$index}{children}) {
push @t,map {[$_,$depth+1]} @{$tree{$index}{children}};
}
}
my %c;
my @out;
my $d=max(keys %d);
while (1) {
my @r;
if (@out) {
foreach my $i (0..$#{$d{$d}}) {
my $si=$tree{$d{$d}[$i]}{children}[0] or die "need a full tree";
$r[$i]=$c{$si}+2;
}
} else {
my $noffsets=scalar @{$d{$d}};
my $j=-2;
while ($noffsets) {
$j+=2;
push @r,$j;
$j+=4;
push @r,$j;
$noffsets-=2;
}
}
my $str=' ' x (max @r);
my $stru=' ' x ((max @r)-1);
my $m=0;
foreach my $i (0..$#{$d{$d}}) {
substr($str,$r[$i],1)=$tree{$d{$d}[$i]}{value};
$c{$d{$d}[$i]}=$r[$i];
unless ($d==0) {
if ($m%2==0) {
substr($stru,$r[$i]+1,1)='/';
} else {
substr($stru,$r[$i]-1,1)='\\';
}
$m++;
}
}
unshift @out,$str;
if ($d>0) {
unshift @out,$stru;
}
if ($d==0) {
last;
}
$d--;
}
print map {"$_\n"} @out;
Part 2 was very much simpler:
Write a script to find the shortest unique prefix for each each word
in the given list. The prefixes will not necessarily be of the same
length.
Sample Input
[ "alphabet", "book", "carpet", "cadmium", "cadeau", "alpine" ]
Expected Output
[ "alph", "b", "car", "cadm", "cade", "alpi" ]
my @input=qw(alphabet book carpet cadmium cadeau alpine);
OK, so let's make these into a hash. (In Perl6 I'd use a Set, but I
had lots of other things to do so I didn't bother with P6 for either
of this week's challenges.)
Then for each candidate length N I fill another hash keyed on the
first N letters; any N-letter tuple that's unique, i.e. there's only
one entry under it, can be dumped and the input word deleted for
faster checking of the rest.
my @out;
my %input=map {$_ => 1} @input;
my $len=1;
while (%input) {
my %k;
map {push @{$k{substr($_,0,$len)}},$_} keys %input;
foreach my $k (keys %k) {
if (scalar keys @{$k{$k}}==1) {
push @out,$k;
delete $input{$k{$k}[0]};
}
}
$len++;
}
I could order them by the original input, but didn't.
print map {"$_\n"} sort @out;
This will fail in the case where one word is the same as the start of
another (e.g. "branch" and "branching"), but the problem itself breaks
down in that case. A terminator character (i.e. something that appears
in no word and can be added to the end of each) would make a solution
possible.
Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.