This is my response to the Perl Weekly Challenge #130.
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.
Example 2:
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:
$ ./oddnumber
5
$ ./oddnumber "2 5 4 4 5 5 2"
5
$ ./oddnumber "1 2 3 4 3 2 1 4 4"
4
#! /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 { /^[19]\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:
$ ./oddnumberperl "2 5 4 4 5 5 2"
5
$ ./oddnumberperl "1 2 3 4 3 2 1 4 4"
4
Binary Search Tree
(BST).
Input:
8
/ \
5 9
/ \
4 6
Output: 1 as the given tree is a BST.
Example 2:
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 @oldnodes;
my @newnodes;
for @btree.reverse > $row
{
my @current = @$row;
@oldnodes = @newnodes;
@newnodes = ();
for @current > $value
{
if $value eq "*"
{
@newnodes.push("*");
next;
}
my $left = @oldnodes.shift // "*"; $left = Nil if $left eq "*";
my $right = @oldnodes.shift // "*"; $right = Nil if $right eq "*";
@newnodes.push(BinaryNode.new(value => $value.Int,
left => $left // Nil,
right => $right // Nil));
}
}
return @newnodes[0];
}
Then a short test program:
File: bintest#! /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:
./bintest 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];';
doit(self);
say '}';
sub doit ($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;";
doit($current.left);
}
if $current.right.defined
{
say " \"node{ $current.value }\":right > \"node{\
$current.right.value }\":center;";
doit($current.right);
}
}
}
A new test program:
File: bingraph#! /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:
$ ./bingraph g > example1.dot
$ dot Tsvg example1.dot > example1.svg
The resulting svg file looks quite nice:
Let us do the second example as well:
$ ./bingraph g "5  4 7  3 6"> example2.dot
$ dot Tsvg example2.dot > example2.svg
The graph uses the value as node ID. That does not work if we have duplicate values:
$ ./bingraph g "5  4 7  3 7"> example2error.dot
$ dot Tsvg example2error.dot > example2error.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 «isbst» 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 minmax(:$verbose)
{
my ($left_min, $left_max) = self.left # {1]
?? self.left.minmax(:$verbose)
!! (self.value, self.value);
my ($right_min, $right_max) = self.right # [2]
?? self.right.minmax(:$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: binarysearchtree#! /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.minmax(:$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:
$ ./binarysearchtree
1
$ ./binarysearchtree "5  4 7  3 8"
0
With verbose mode:
$ ./binarysearchtree 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
$ ./binarysearchtree 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 isbst(:$verbose) # [1]
{
try # [2]
{
CATCH
{
return False;
}
self.minmax(:$verbose); # [3]
return True; # [4]
}
}
method minmax(:$verbose)
{
my ($left_min, $left_max) = self.left
?? self.left.minmax(:$verbose)
!! (self.value, self.value);
my ($right_min, $right_max) = self.right
?? self.right.minmax(:$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: binarysearchtree2#! /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.isbst(:$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:
$ ./binarysearchtree2 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
$ ./binarysearchtree2 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];';
doit(self);
say '}';
sub doit ($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;";
doit($current.left);
}
if $current.right.defined
{
say " \"node{ $current.identifier }\":right > \"node{ $current.right.identifier }\":center;";
doit($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 «bingraph» program (using «BinaryNode2» instead of «BinaryNode2» is included in the zip file. Running it:
./bingraph2 g "5  4 7  3 7"> example2ok.dot
2536 dot Tsvg example2ok.dot > example2ok.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.