THE WEEKLY CHALLENGE – PERL & RAKU #56
TASK #1
Diff-K
You are given an array @N of positive integers (sorted) and another non negative integer k.
Write a script to find if there exists 2 indices i and j such that A[i] – A[j] = k and i != j.
It should print the pairs of indices, if any such pairs exist.
Example:
@N = (2, 7, 9)
$k = 2
Output : 2,1
Method
A little mathematical analysis will help here.
Given that
∀ n:
A[n] > 0
A[n+1] ≥ A[n]
k ≥ 0
And the required truths
A[i] – A[j] = k
i ≠ j
For these to be true, we can conclude that
A[i] > k
A[j] ≤ A[i]
which allows us to limit the search space somewhat for a brute force attack on the problem.
In fact, because A[j] = A[i] – k, we only need to iterate over the possible i range and then can use a hash lookup for the second part of the search. Note that we can’t outright assume that j < i because there exists the case where A[j] = A[i] and j > i. In general, because we allow duplicate values, there can exist multiple j solutions for a given i; we use use a cascading grep filter to produce an array of results for each i in the loop.
Perl Solution
[colincrain:~/PWC]$ perl 56_1_diffickult.pl
input
-----
array: 4, 7, 10, 14, 16, 20, 26, 27, 31, 32, 32, 33, 34, 38, 38, 39, 42, 44, 46, 49
target: 24
solutions
---------
i = 8, j = 1 --> 31 - 7 = 24
i = 12, j = 2 --> 34 - 10 = 24
i = 13, j = 3 --> 38 - 14 = 24
i = 14, j = 3 --> 38 - 14 = 24
i = 17, j = 5 --> 44 - 20 = 24
use warnings;
use strict;
use feature ":5.26";
## ## ## ## ## MAIN:
my $k = shift @ARGV // 24;
my @input;
push @input, int(rand(50)) for (1..20);
@input = sort { $a <=> $b } @input;
my @indices = (0..scalar @input - 1);
my @output;
my @is = grep { $input[$_] > $k } @indices;
for my $i ( @is ) {
## for each $i we can do a lookup and see whether any values
## $input[$j] = $input[$i] - $k exist
## we need to make allowances that adjacent multiple indices
## may hold equal values
my @js = grep { $input[$_] <= $input[$i] ## A[j] <= A[i]
&& $input[$_] == $input[$i] - $k ## A[j] = A[i] - k
&& $_ != $i } @indices; ## i != j
for my $j ( @js ) {
push @output, [ $i, $j ];
}
}
## output report
##
say "input\n-----\n";
say ' array: ', join ', ', @input;
say "target: $k";
say '';
say "solutions\n---------\n";
for (@output) {
my ( $i, $j) = $_->@*;
printf "i = %2d, j = %-2d --> %2d - %-2d = %d\n",
$i, $j, $input[$i], $input[$j], $k;
}
Raku Solution
The Raku follows the same logic as the Perl.
sub MAIN (Int:D $k = 24, *@N) {
my @input = @N.elems > 0 ?? @N !! (^20).map({ (1..50).pick }).sort({ $^a <=> $^b });
my @indices = (^@input.elems);
my @output;
my @is = @indices.grep({ @input[$_] > $k });
## for each $i we can do a lookup and see whether any values
## $input[$j] = $input[$i] - $k exist
for @is -> $i {
my @js = @indices.grep({ @input[$_] <= @input[$i] ## A[j] <= A[i]
&& @input[$_] == @input[$i] - $k }); ## A[i] - A[j] = k
&& $_ != $i ## i != j
for @js -> $j { @output.push: [ $i, $j ] }
}
## output report section
say "input\n-----\n";
say ' array: ' ~ @input.join: ', ',;
say "target: $k";
say '';
say "solutions\n---------\n";
my $format = "i = %2d, j = %-2d --> %2d - %-2d = %d\n";
printf $format, $_[0], $_[1], @input[$_[0]], @input[$_[1]], $k for @output;
}
TASK #2
Path Sum
You are given a binary tree and a sum, write a script to find if the tree has a path such that adding up all the values along the path equals the given sum. Only complete paths (from root to leaf node) may be considered for a sum.
Example
Given the below binary tree and sum = 22,
5
/ \
4 8
/ / \
11 13 9
/ \ \
7 2 1
For the given binary tree, the partial path sum 5 → 8 → 9 = 22 is not valid.
The script should return the path 5 → 4 → 11 → 2 whose sum is 22.
Method
The challenge is on the surface pretty straightforward; the binary tree data structure was designed to be transversed, so a recursive routine that walks the paths until it finds a terminator node would do the trick. Once the path is found, we can compare the sum and if it fits log it.
The problem rears its head here with the phrase “given a binary tree and a sum”. What does that mean? Not what is a binary tree, of course. But what does it mean here? We are given an ascii drawing of an example tree. Although I spent more time than I’d like to admit considering directly parsing this format it’s ill-defined itself and a totally useless effort. Not that that ever stopped me before, mind you; I still may get to it. For the greater good. For the ASCII art. Maybe a reader and writer. Sure thing, get right on it…
But how then, should we encode our tree? In Set theory, each node of a binary tree can be defined as {L, S, R} for the Left child, Singleton value, and Right child sets. The value is a Singleton set, the others binary tree sets themselves or empty sets.* The example tree could thusly be encoded:
{{{∅,7,∅},11,{∅,2,∅}},4,∅},5,{{∅,13,∅},8,{∅,9,{∅,1,∅}}}
If I was to build this structure in perl for some practical use, a natural way would be to define a tree node object and add in nodes as we aquire the data. This could be done with a blessing a proper Node objects, in a package, but at its heart each node is a hash with three keys: {left}, {right} and {value}, to hold the value and references (or undef) for the left and right children .
The example would then look like this:
$data = { value => 5,
left => { value => 4,
left => { value => 11,
left => { value => 7,
left => undef,
right => undef
}
right => { value => 2,
left => undef,
right => undef
}
}
right => undef
}
right => { value => 8,
left => { value => 13,
left => undef,
right => undef
}
right => { value => 9,
left => undef
right => { value => 1,
left => undef,
right => undef
} But this isn’t a very practical way to give anything to anybody, is it? Once loaded it provides the functionality, but it’s hardly command-line friendly.
A third way of implimenting this structure is to imagine every node in every rank as complete, assigning the values of the nodes into fixed indices of an array; starting with the rank 0 node at index 0, proceeding with the next level into indices 1 and 2, etcetera, in a level-first traversal. A given index for a null set child is filled with a null value, undef for Perl, and its theoretical children with null values as well, thus maintaining synchronization with the level structure no matter the shape of the actual tree. Each child is located relative to its parent, index n, at indices 2n + 1 and 2n + 2, so traversing a given path is a matter of following from parent to child, recusively, as long as there is another defined value to jump to.
In this manner the example tree can be encoded, in perl, as
@tree = (5, 4, 8, 11, undef, 13, 9, 7, 2, undef, undef, undef, undef, undef, 1)
Notice there’s a fair amount of wasted space in this encoding, as every node must be given an index, whether it’s populated or not, or even whether its parent exists or not. It does provide a simple relationship between parent and child nodes that can be easily visualized for smaller trees. Due to its fairly compact serialized nature and (mostly) human readable form we will use this method to encode our tree.
Traversing all possible paths in the tree using a recursive routine as described is executed in sum_path(), below. Originally I allowed passing in a target and tree array from the commandline, but found that even though the serialized tree format is somewhat human-readable, writing an arbitrary new tree to demonstrate the behavior proved troublesome, to say the least. So alternately, I decided it was easier to make functions that generates random trees and median targets, and used those for input data instead. Tweaking the algorithm to give a semi-random tree that also was a good demonstration example proved more complicated than I first expected, but after a little work I think we’re there. The odds of any given node as being a terminator increase as the level, or rank, increases. A high point was the little function that reverse-engineers the construction algorithm to produce the rank level from an input index.
In the output, the input tree is listed, along with the target. Because I thought it was interesting, all traversals are noted as they are found, with their sums. At the end, the data asked for, those paths that sum to the target, are listed.
- Discrete Mathematics : Proofs, Structures and Applications, Third Edition (Garnier, Rowan, Taylor, John) 2009
“A binary tree comprises a triple of sets (L, S, R) where L and R are binary trees (or are empty) and S is a singleton set. The single element of S is the root, and L and R are called, respectively, the left and right subtrees of the root.”
Perl Solution
[colincrain:~/PWC]$ perl 56_2_pathsum.pl
tree: 4, 3, 5, 4, 7, 0, 1, 4, 9, 6, 7, 0, 1, 8, 6, undef, 4, 0, 2, 9, 9, 3, 8, 0, 6, 5, 1, 9, 4, 1, 1
target: 22
paths found:
4 -> 3 -> 4 -> 4 -> 4 = 19
4 -> 3 -> 4 -> 9 -> 0 = 20
4 -> 3 -> 4 -> 9 -> 2 = 22
4 -> 3 -> 7 -> 6 -> 9 = 29
4 -> 3 -> 7 -> 6 -> 9 = 29
4 -> 3 -> 7 -> 7 -> 3 = 24
4 -> 3 -> 7 -> 7 -> 8 = 29
4 -> 5 -> 0 -> 0 -> 0 = 9
4 -> 5 -> 0 -> 0 -> 6 = 15
4 -> 5 -> 0 -> 1 -> 5 = 15
4 -> 5 -> 0 -> 1 -> 1 = 11
4 -> 5 -> 1 -> 8 -> 9 = 27
4 -> 5 -> 1 -> 8 -> 4 = 22
4 -> 5 -> 1 -> 6 -> 1 = 17
4 -> 5 -> 1 -> 6 -> 1 = 17
solutions:
4 -> 3 -> 4 -> 9 -> 2
4 -> 5 -> 1 -> 8 -> 4
use warnings;
use strict;
use feature ":5.26";
## ## ## ## ## MAIN:
our $depth = 7;
our @tree = generate_tree($depth);
say "tree: ", join ', ', map {defined $_? $_ : "undef"} @tree;
our $target = shift // int (($depth+1) * 4.5) ;
say "target: $target";
say "";
say "paths found:\n";
my $index = 0;
my $working = [];
our $paths = [];
sum_path ($index, $working);
say "\nsolutions:\n";
if (scalar $paths->@* == 0) {
say '(none)';
}
else {
say join ' -> ', $_->@* for $paths->@*;
}
## ## ## ## ## SUBS:
sub sum_path {
## walks the tree and computes complete the path sum
my ($index, $working) = @_;
my @working = $working->@*;
push @working, $tree[$index];
## if we are at a terminal node check the sum and return
if ( ! defined $tree[$index * 2 + 1] && ! defined $tree[$index * 2 + 2] ) {
my $sum;
$sum += $_ for @working;
push $paths->@*, \@working if ($sum == $target);
print (join ' -> ', map {defined $_ ? $_ : "undef"} @working);
say " = $sum";
return;
}
## walk to next nodes if present
for my $child ( $index * 2 + 1, $index * 2 + 2 ) {
sum_path( $child, \@working ) if defined $tree[$child];
}
}
sub generate_tree {
## automatically generates a binary tree of rank n.
## odds of a node being a terminator increase as the rank of the node increases
## which avoids trees with branches that quickly end
my $depth = shift;
my @tree;
$tree[0] = int(rand(10)); ## always defined
my $nodes = (2**($depth+1)) - 2; ## 0-based count to last node,
## start of next rank - 1
for my $index ( 0..$nodes ) {
my $rank = get_rank($index); ## determines the rank of a node from its index
my $parent = int(($index-1)/2);
if ( defined $tree[$parent]) {
## the odds of the switch being 0 increase as the rank progresses
## the start node, rank 0, will always generate the next rank
my $switch = $index > 0 ? int(rand ($nodes - 2 ** $rank)/2) : 1 ;
@tree[$index] = $switch ? int(rand(10)) : undef;
}
}
return @tree;
}
sub get_rank {
## determines the rank of a node from its index
my $n = shift;
return $n > 0 ? int log($n+1)/log(2) : 0;
}Raku Solution
The Raku version of this has its own version of building classes, so the example of building a binary tree would look something like this:
class Node {
has Node $.left;
has Node $.right;
has $.value;
}
my Node $tree .= new( value => 5,
left => Node.new( value => 4,
left => Node.new( value => 11,
left => Node.new(value => 7),
right => Node.new(value => 2)
)
),
right => Node.new( value => 8,
left => Node.new( value => 13),
right => Node.new( value => 9
right => Node.new( value => 1)
)
)
);
This code is untested, but looks right. But we’re still not going to use it. Nah, porting the Perl version will be interesting unto itself.
sub MAIN ($depth = 3) {
my @tree = generate_tree($depth);
my $tstr = @tree.map({$_.defined ?? $_ !! "undef"}).join(', ');
my $target = (($depth+1) * 4.5).Int;
say qq:to/__END__/;
tree: $tstr
target: $target
paths found:
__END__
my $index = 0;
my @working;
my @paths;
sum_path(@tree, $target, $index, @working, @paths);
say "\nsolutions:\n";
@paths.elems == 0 ?? say '(none)' !! ($_.join(' -> ').say for @paths);
}
## ## ## ## ## SUBS:
sub sum_path (@tree, $target, $index, @prev_working, @paths) {
## walks the tree and computes complete the path sum
my @working = @prev_working;
@working.append: @tree[$index];
## if we are at a terminal node check the sum and return
if ( ! @tree[$index * 2 + 1].defined && ! @tree[$index * 2 + 2].defined ) {
my $sum = [+] @working;
@paths.push: @working if $sum == $target;
say @working.join(' + ') ~ " = $sum";
return;
}
for ( $index * 2 + 1, $index * 2 + 2 ) -> $child {
sum_path( @tree, $target, $child, @working, @paths ) if @tree[$child].defined;
}
}
sub generate_tree ($depth){
## automatically generates a random binary tree of rank n, with node values 1..10
## odds of a node being a terminator increase as the rank of the node increases
## which avoids trees with branches that quickly end
my @tree;
@tree[0] = (^10).pick; ## always defined
my $nodes = (2**($depth+1)) - 2; ## 0-based count to last node, (start of next rank - 1)
for ( 0..$nodes ) -> $index {
my $rank = get_rank($index);
my $parent = (($index-1)/2).Int;
if @tree[$parent].defined {
## the odds of the switch being 0 increase as the rank progresses
## the first node will always generate the next rank
my $switch = $index > 0 ?? (^($nodes - 2 ** $rank)/2).pick.Int !! 1;
@tree[$index] = $switch ?? (^10).pick !! Nil;
}
}
return @tree;
}
sub get_rank ($n) {
## determines the rank of a node from its index
return $n > 0 ?? (log($n+1)/log(2)).Int !! 0;
}
Programming Excursions in Perl and Raku 