The Odd Tree with Raku and Perl
[146] Published 19. September 2021.This is my response to the Perl Weekly Challenge #130.
Challenge #130.1: Odd Number
Write a script to find that integer.
Example 1:
Input: @N = (2, 5, 4, 4, 5, 5, 2)
Output: 5 as it appears 3 times in the array where as all other numbers
2 and 4 appears exactly twice.
Input: @N = (1, 2, 3, 4, 3, 2, 1, 4, 4)
Output: 4
Counting duplicates is easy when
we use a Bag - a hash like structure with weight. E.g.
> say "2 5 4 4 5 5 2".words.Bag; # -> Bag(2(2) 4(2) 5(3))
The keys in the hash (2, 4 and 5) are the unique values, and the values (2, 2 and 3) are the weight.
See
docs.raku.org/type/Bag
for more information about the Bag type.
#! /usr/bin/env raku
unit sub MAIN ($numbers = "2 5 4 4 5 5 2"); # [1]
my @numbers = $numbers.words; # [2]
die "Positive integers only" unless all(@numbers) ~~ /^<[1..9]>\d*$/; # [3]
my %count = @numbers.Bag; # [4]
my @odd = %count.keys.grep({ %count{$_} % 2 }); # [5]
die "Did not find one (and only one) match. Found: \
{ @odd ?? @odd.join(", ") !! 'none' }" if @odd.elems != 1; # [6]
say @odd[0]; # [7]
See
docs.raku.org/type/Bag
for more information about the Bag type.
[1] Specify the numbers as a space separated string.
[2] Get the individual values.
[3] Ensure positive integers only. This excludes zero, and the regex prevents numbers starting with zero as well.
[4] Turn the values into a bag.
[5] Filter out the values with an odd count.
[6] We should have exactly one match. Complain forcefully if not.
[7] Print the first (and only) match.
Running it:
$ ./odd-number
5
$ ./odd-number "2 5 4 4 5 5 2"
5
$ ./odd-number "1 2 3 4 3 2 1 4 4"
4
A Perl Version
This is straight forward translation of the Raku version. File: odd-number-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
my $numbers = $ARGV[0]
// die 'Please specify a string containing numbers'; # [1]
my @numbers = split(/\s+/, $numbers);
map { /^[1-9]\d*$/ || die "$_ is not an integer" } @numbers; # [2]
my %count;
map { $count{$_}++ } @numbers; # [3]
my @odd = grep { $count{$_} % 2 } keys %count;
die "Did not find one (and only one) match. Found: "
. ( @odd ? join(", ", @odd) : 'none') if @odd != 1;
say join(", ", @odd);
[1] No default string in this version.
[2] I could have used «all» from the
«Perl6::Junction» module,
but using map like this works quite well.
[3] Perl does not have a Map type (as Raku), but using map to mimic
the behaviour is easy.
Running it gives the same result as the Raku version:
$ ./odd-number-perl "2 5 4 4 5 5 2"
5
$ ./odd-number-perl "1 2 3 4 3 2 1 4 4"
4
Challenge #130.2: Binary Search Tree
Write a script to find out if the given tree is
Binary Search Tree
(BST).
According to wikipedia, the definition of BST:
A binary search tree is a rooted binary tree, whose internal nodes each store a key (and optionally, an associated value), and each has two distinguished sub-trees, commonly denoted left and right. The tree additionally satisfies the binary search property: the key in each node is greater than or equal to any key stored in the left sub-tree, and less than or equal to any key stored in the right sub-tree. The leaves (final nodes) of the tree contain no key and have no structure to distinguish them from one another.
Example 1:
Input:
8
/ \
5 9
/ \
4 6
Output: 1 as the given tree is a BST.
Input:
5
/ \
4 7
/ \
3 6
Output: 0 as the given tree is a not BST.
We have created binary trees a lot of times before, including Pythagorean Tree with Raku; Challenge #125.2: Binary Tree Diameter. So let us reuse most of the code, without explaining it again…
For some unfathomable reason the code that generated the tree was placed in a procedure (by me, alas), and not inside the class as a method. Let us rectify that.
File: lib/BinaryNode.rakumod (partial)
unit class BinaryNode;
has Int $.value;
has BinaryNode $.left;
has BinaryNode $.right;
method create ($string)
{
die "Call on the class only" if self ~~ BinaryNode:D;
my @btree = $string.split("|")>>.words;
my @old-nodes;
my @new-nodes;
for @btree.reverse -> $row
{
my @current = @$row;
@old-nodes = @new-nodes;
@new-nodes = ();
for @current -> $value
{
if $value eq "*"
{
@new-nodes.push("*");
next;
}
my $left = @old-nodes.shift // "*"; $left = Nil if $left eq "*";
my $right = @old-nodes.shift // "*"; $right = Nil if $right eq "*";
@new-nodes.push(BinaryNode.new(value => $value.Int,
left => $left // Nil,
right => $right // Nil));
}
}
return @new-nodes[0];
}
Then a short test program:
File: bin-test
#! /usr/bin/env raku
use lib "lib";
use BinaryNode;
unit sub MAIN (Str $tree = "8 | 5 9 | 4 6", :v(:$verbose));
my $btree = BinaryNode.create($tree);
say ": { $btree.raku }" if $verbose;
Running it, with verbose mode. Newlines and indentation added to enhance readability slightly:
./bin-test -v
: BinaryNode.new(
value => 8,
left => BinaryNode.new(
value => 5,
left => BinaryNode.new(
value => 4,
left => BinaryNode,
right => BinaryNode),
right => BinaryNode.new(
value => 6,
left => BinaryNode,
right => BinaryNode)),
right => BinaryNode.new(
value => 9,
left => BinaryNode,
right => BinaryNode))
Not very nice looking, even with the manual nicification, and there really isn't very much we can do about that.
But we can add the visual graph creation code from the second part of Re Re Raku (and Perl); Challenge #113.2: Recreate Binary Tree. Look up that article for details and explanations.
File: lib/BinaryNode.rakumod (partial)
method graph
{
say 'digraph foogrph {';
say ' node [shape = record,height=.1];';
do-it(self);
say '}';
sub do-it ($current)
{
say " node{ $current.value }[label = \"<left> |<center> { \
$current.value }|<ight> \"];";
if $current.left.defined
{
say " \"node{ $current.value }\":left -> \"node{ \
$current.left.value }\":center;";
do-it($current.left);
}
if $current.right.defined
{
say " \"node{ $current.value }\":right -> \"node{\
$current.right.value }\":center;";
do-it($current.right);
}
}
}
A new test program:
File: bin-graph
#! /usr/bin/env raku
use lib "lib";
use BinaryNode;
unit sub MAIN (Str $tree = "8 | 5 9 | 4 6", :v(:$verbose), :g(:$graph));
my $btree = BinaryNode.create($tree);
say ": { $btree.raku }" if $verbose;
$btree.graph if $graph;
Running it, and then Graphviz (the «dot» program) on the result to generate the image:
$ ./bin-graph -g > example1.dot
$ dot -Tsvg example1.dot > example1.svg
The resulting svg file looks quite nice:
Let us do the second example as well:
$ ./bin-graph -g "5 | 4 7 | 3 6"> example2.dot
$ dot -Tsvg example2.dot > example2.svg
Duplicate Node Values
The graph uses the value as node ID. That does not work if we have duplicate values:
$ ./bin-graph -g "5 | 4 7 | 3 7"> example2-error.dot
$ dot -Tsvg example2-error.dot > example2-error.svg
(I have changed the last value from 6 to 7.)
The problem is that the node ID is written as node{ $current.value },
where the last part is the node value. Replacing that with a unique identifier solves
the problem. But this is tricky, as we have to replace the correct node values.
I will get back to this later on.
On to the challenge...
I am doing this with a recursive method, working its way down the tree, collapsing each node to a minumum and maximum value on its way up.
I'll start by presenting the steps with illustrations, and do the code afterwards.
| We start with the original tree. |
 |
Then we recurse our way to the last node on the left hand side. There are no more
child nodes, so it collapses the missing left child min and max values to the node
value. And the same for the missing right child node. The maximum from the left,
should be lower or equal to the node value, which in turn should be higher or
equal to the minumum from the right. (The rule:
left.max <= node.value <= right.min.) If ok, then the values (max left,
min right) are returned "upstairs". |
|
| The next step up, with the maximum left and the minimum right (from the left child) in place. |
 |
Then we do the right child. This node deos not have any child nodes, so we set
all the four values (left min, left max, right min, right max) to the node value
itself; 6. They satisfy our rule (left.max <= node.value <= right.min),
so we continue.
|
 |
We have collapsed the values from the right child. The values satisfy our rule
(left.max <= node.value <= right.min), so we continue.
|
 |
| We have collapsed the left child. |
 |
The right child does not have and child node, so we set all the four values (left min,
left max, right min, right max) to the node value itself; 9. They satisfy our rule
(left.max <= node.value <= right.min), so we continue.
|
|
We have collapsed the right child. The values satisfy our rule
(left.max <= node.value <= right.min), so we can continue.
|
|
There are no more nodes to collapse, so we are good to go. They all satisfy the rule. |
|
You may have noticed that we do not need
the left.min and right.max values. But we return them anyway,
allowing us to ignore the difference between a left or right node when we are in it.
The second example:
| The original tree. |
 |
| As before. |
 |
| As before. |
 |
| As before. |
 |
| As before. |
 |
| Here we have a problem, as the max value (6) is higher than the node value (5). The tree is not a binary search tree, and we can stop checking. |
 |
| The tree is not a binary search tree. Print 0. |
|
I have chosen to make an «is-bst» method. Call it on the top node (the tree), and it will recurse down, and upwards again. It will print 1 on success (tree is a BST), or 0 on failure (tree is not a BST).
File: lib/BinaryNode.rakumod (partial)
method min-max(:$verbose)
{
my ($left_min, $left_max) = self.left # {1]
?? self.left.min-max(:$verbose)
!! (self.value, self.value);
my ($right_min, $right_max) = self.right # [2]
?? self.right.min-max(:$verbose)
!! (self.value, self.value);
say ": Node: { self.value } : Left min: $left_min, max: $left_max \
| Right min: $right_min, max: $right_max" if $verbose;
{ say 0; exit } if $left_max > self.value || $right_min < self.value; # [3]
return ( min($left_min, $right_min, self.value), # [4]
max($left_max, $right_max, self.value) );
}
[1] Get the (min and max) values from the left subtree, if any. If not, use the current node value.
[2] As [1], but for the right subtree.
[3] Check that the rule (see 1b and 2f above) holds. If not, print zero and terminate the program. Termination is a dirty trick to get out of the recursive calls.
[4] Return the min and max values for this subtree.
The program:
File: binary-search-tree
#! /usr/bin/env raku
use lib "lib";
use BinaryNode;
unit sub MAIN (Str $tree = "8 | 5 9 | 4 6", :v(:$verbose));
my $btree = BinaryNode.create($tree);
# say ": { $btree.raku }" if $verbose;
say 1 if $btree.min-max(:$verbose); # [5]
[5] The program will only reach this line of code if the have a BST. (The
exit in [3] has taken care of that.)
Running it:
$ ./binary-search-tree
1
$ ./binary-search-tree "5 | 4 7 | 3 8"
0
With verbose mode:
$ ./binary-search-tree -v
: Node: 4 : Left min: 4, max: 4 | Right min: 4, max: 4
: Node: 6 : Left min: 6, max: 6 | Right min: 6, max: 6
: Node: 5 : Left min: 4, max: 4 | Right min: 6, max: 6
: Node: 9 : Left min: 9, max: 9 | Right min: 9, max: 9
: Node: 8 : Left min: 4, max: 6 | Right min: 9, max: 9
1
$ ./binary-search-tree -v "5 | 4 7 | 3 8"
: Node: 3 : Left min: 3, max: 3 | Right min: 3, max: 3
: Node: 8 : Left min: 8, max: 8 | Right min: 8, max: 8
: Node: 4 : Left min: 3, max: 3 | Right min: 8, max: 8
: Node: 7 : Left min: 7, max: 7 | Right min: 7, max: 7
: Node: 5 : Left min: 3, max: 8 | Right min: 7, max: 7
0
Looking good.
But...
We do not have a method telling us if the tree is BST. The program works, by exiting the program. That is not a nice thing to do. Especially if we want to do other things afterwards.
It is easy to fix that:
File: lib/BinaryNode.rakumod2 (changes only)
method is-bst(:$verbose) # [1]
{
try # [2]
{
CATCH
{
return False;
}
self.min-max(:$verbose); # [3]
return True; # [4]
}
}
method min-max(:$verbose)
{
my ($left_min, $left_max) = self.left
?? self.left.min-max(:$verbose)
!! (self.value, self.value);
my ($right_min, $right_max) = self.right
?? self.right.min-max(:$verbose)
!! (self.value, self.value);
say ": Node: { self.value } : Left min: $left_min, max: $left_max \
| Right min: $right_min, max: $right_max" if $verbose;
die "Not BST" if $left_max > self.value || $right_min < self.value; # [2a]
return ( min($left_min, $right_min, self.value),
max($left_max, $right_max, self.value) );
}
[1] A new method that we should use to check that the tree is a BST.
[2] This handler catches the die in [2a] (where it replaced exit),
if executed, and returns False instead of terminating the program.
[3] Off we go.
[4] We have a BST if we ge there. Return True.
The modified program:
File: binary-search-tree2
#! /usr/bin/env raku
use lib "lib";
use BinaryNode;
unit sub MAIN (Str $tree = "8 | 5 9 | 4 6", :v(:$verbose));
my $btree = BinaryNode.create($tree);
# say ": { $btree.raku }" if $verbose;
say + $btree.is-bst(:$verbose); # [5]
# say "Hello";
[5] The method returns True or False, and we want 1 or 0.
Coercing the value to a Numeric (with + does that for us).
Running it gives the same result as before:
$ ./binary-search-tree2 -v
: Node: 4 : Left min: 4, max: 4 | Right min: 4, max: 4
: Node: 6 : Left min: 6, max: 6 | Right min: 6, max: 6
: Node: 5 : Left min: 4, max: 4 | Right min: 6, max: 6
: Node: 9 : Left min: 9, max: 9 | Right min: 9, max: 9
: Node: 8 : Left min: 4, max: 6 | Right min: 9, max: 9
1
$ ./binary-search-tree2 -v "5 | 4 7 | 3 8"
: Node: 3 : Left min: 3, max: 3 | Right min: 3, max: 3
: Node: 8 : Left min: 8, max: 8 | Right min: 8, max: 8
: Node: 4 : Left min: 3, max: 3 | Right min: 8, max: 8
: Node: 7 : Left min: 7, max: 7 | Right min: 7, max: 7
: Node: 5 : Left min: 3, max: 8 | Right min: 7, max: 7
0
Uncomment the last line (in the program) if you want to see for yourself that it is not prematurely terminated on failure.
And that's it.
Except that it isn't…
I promised to fix the graph creation with duplicate values in the tree. So here it is:
File: lib/BinaryNode2.rakumod (partial)
method identifier
{
self.Str ~~ /(\d\d+)/;
return $0.Str;
}
method graph
{
say 'digraph foogrph {';
say ' node [shape = record,height=.1];';
do-it(self);
say '}';
sub do-it ($current)
{
say " node{ $current.identifier }[label = \"<left> |<center> { $current.value }|<right> \"];";
if $current.left.defined
{
say " \"node{ $current.identifier }\":left -> \"node{ $current.left.identifier }\":center;";
do-it($current.left);
}
if $current.right.defined
{
say " \"node{ $current.identifier }\":right -> \"node{ $current.right.identifier }\":center;";
do-it($current.right);
}
}
}
We use the «indentifier» method instead of «value» to get a unique value. Calling .Str
on an object will give a string like this: BinaryNode2<93836960267224>.
The first part is the class name, followed by the memory location (sort of) in funny quotes. The «identifier» method extract the memory address. It may not be accurate, but it is unique.
A modified version of the «bin-graph» program (using «BinaryNode2» instead of «BinaryNode2» is included in the zip file. Running it:
./bin-graph2 -g "5 | 4 7 | 3 7"> example2-ok.dot
2536 dot -Tsvg example2-ok.dot > example2-ok.svg
Looking good.
It is probably unwise to rely on how Raku chooses to stringify objects, as this may change. The memory location may also change during execution of a program, especially if the garbage collector has been involved.
And that's it. Really.