Re Re Raku (and Perl)

[129] Published 22. May 2021.

This is my response to the Perl Weekly Challenge #113.

Challenge #113.1: Represent Integer

You are given a positive integer $N and a digit $D.

Write a script to check if $N can be represented as a sum of positive integers having $D at least once. If check passes print 1 otherwise 0.

Example:

Input: $N = 25, $D = 7
Output: 0 as there are 2 numbers between 1 and 25 having the digit 7
          i.e. 7 and 17. If we add up both we don't get 25.

Input: $N = 24, $D = 7
Output: 1

File: represent-integer

#! /usr/bin/env raku

unit sub MAIN (Int $N where $N > 0,           # [1]
               Int $D where $D.chars == 1,    # [2]
               :v($verbose));

my @candidates = (1 .. $N).grep( * ~~ /$D/);  # [3]

say ": Candidates { @candidates.join(', ') }" if $verbose;

for @candidates.combinations(1..*) -> @comb   # [4]
{
  say ": Considering { @comb.join(' + ') }" if $verbose;

  if @comb.sum == $N                          # [5]
  {
    say 1;                                    # [5a]
    exit;                                     # [5b]
  }
}

say 0;                                        # [6]

[1] Ensure a positive integer.

[2] Ensure a single digit.

[3] All possible values we can add togeter, starting with every value between 1 and $N. Then we apply grep to get rid of values where the digit $D does not occur.

[4] For every combination of values from the candidate values (where (1..*) means every size from 1 to infinite; i.e. we skip the empty list),

[5] Do the values sum up to $N? If so, print 1 [5a] and exit [5b]. If not, the loop goes on.

[6] If we get here, it means that we did not find a match. Print 0.

See docs.raku.org/routine/combinations for more information about combinations.

Running it:

$ ./represent-integer 25 7
0

$ ./represent-integer 24 7
1

With verbose mode:

 ./represent-integer -v 25 7
: Candidates 7, 17
: Considering 7
: Considering 17
: Considering 7 + 17
0

$ ./represent-integer -v 24 7
: Candidates 7, 17
: Considering 7
: Considering 17
: Considering 7 + 17
1

Looking good.

A Perl Version

This is straight forward translation of the Raku version.

File: represent-integer-perl

#! /usr/bin/env perl

use strict;
use feature 'say';

use Algorithm::Combinatorics 'combinations';
use List::Util 'sum';
use Getopt::Long;

my $verbose = 0;
GetOptions("verbose"  => \$verbose);

my $N = shift(@ARGV) // die "Please specify an integer > 0";
die "Please specify an integer > 0" unless $N =~ /^[1-9]\d*$/;

my $D = shift(@ARGV) // die "Please specify a digit";
die "Please specify a digit" unless $D =~ /^\d$/;

my @candidates = grep { /$D/ } (1 .. $N);

say ": Candidates " . join(', ', @candidates) if $verbose;

for my $size (1 .. @candidates)                                 # [1]
{
  for my $comb (combinations(\@candidates, $size))
  {
    say ": Considering " . join(' + ', @$comb) if $verbose;

    if (sum(@$comb) == $N)
    {
      say 1;
      exit;
    }
  }
}

say 0;

[1] «Algorithm::Combinatorics::combinations» does not support multiple sizes, so we must add an outer loop to remedy that (and explicitly ask for a given size).

Running it gives the same result as the Raku version:

$ ./represent-integer-perl -v 25 7
: Candidates 7, 17
: Considering 7
: Considering 17
: Considering 7 + 17
0

$ ./represent-integer-perl -v 24 7
: Candidates 7, 17
: Considering 7
: Considering 17
: Considering 7 + 17
1

Challenge #113.2: Recreate Binary Tree

You are given a Binary Tree.

Write a script to replace each node of the tree with the sum of all the remaining nodes.

Example:
Input Binary Tree:

Output Binary Tree:

The expression «you are given a Binary Tree» beautifully glosses out the details of how this tree is supposed to be given. The textual format presented in the example is readable for a human, but not so for a program.

We do need a suitably compact (as in command line comapatible) format. I have prsented that a couple of times before, and the most recent one was Binary Linked Anagrams with Raku. Scroll down to Challenge #094.2: Binary Tree to Linked List.

Let us start with that format, and do the whole operation on that format - without actually building a binary tree:

Note that we have to calculate the sum before we start messing about with the values. (The challenge does not say that we are limitied to integers, so I allow anything with at least one digit. This works as long as sum is able to get a numeric value.

File: recreate-binary-tree

#! /usr/bin/env raku

unit sub MAIN (Str $tree = '1 | 2 3 | 4 * 5 6 | * 7', :v($verbose));  # [1]

my $sum = $tree.words.grep( * ~~ /\d/ ).sum;                          # [2]

say ": Sum: $sum" if $verbose;

my @elems;                                                            # [3]

for $tree.words -> $elem                                              # [4]
{
  $elem ~~ /\d/                                                       # [4a]
   ?? @elems.push: $sum - $elem                                       # [4b]
   !! @elems.push: $elem;                                             # [4c]
}

say @elems.join(" ");                                                 # [5]

[1] Note the format. We use | to separate the rows, and spaces between the values. Missing values are given as *, but only when we need a gap in the tree.

[2] Split the tree string into a list of values, get rid of the non-numeric ones, and get the sum of remaining values.

[3] The list of modified values will end up here.

[4] For each element (word) in the tree string, replace the value with the modified on [4b] if it is numeric. If not, keep the value [4c].

[5] Join the elements, giving a modified tree with the same syntax as given on the command line.

Running it:

$ ./recreate-binary-tree
27 | 26 25 | 24 * 23 22 | * 21

$ ./recreate-binary-tree -v '1 | 2 3 | 4 * 5 6 | * 7'
: Sum: 28
27 | 26 25 | 24 * 23 22 | * 21

Looking good.

Except that it does not look remotely like a tree. I&apo;ll get back to that, later.

Perl

This is a straight forward translation of the Raku version.

File: recreate-binary-tree-perl

#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';

use Getopt::Long;
use List::Util qw(sum);

my $verbose = 0;

GetOptions("verbose" => \$verbose);

my $tree = shift(@$ARGV) // '1 | 2 3 | 4 * 5 6 | * 7';

my $sum = sum(grep(/\d/, split(/\s+/, $tree)));

say ": Sum: $sum" if $verbose;

my @elems;

for my $elem (split(/\s+/, $tree))
{
  $elem =~ /\d/
   ? push(@elems, $sum - $elem)
   : push(@elems, $elem);
}

say join(" ", @elems);

Running it gives the same result as the Raku version:

$ ./recreate-binary-tree-perl 
27 | 26 25 | 24 * 23 22 | * 21

$ ./recreate-binary-tree-perl -v '1 | 2 3 | 4 * 5 6 | * 7'
: Sum: 28
27 | 26 25 | 24 * 23 22 | * 21

A Real Tree!

We should really generate a tree, both as a data structure and visually. This will not add any value as such to the program, but a real tree (well, not really, but you get the idea) is in the spirit of the challenge.

Printing a tree is a tricky business, so I have chosen to delegate that task to an external program; Vizgraph. See my Pokemon Chiao, Raku article for an introduction.

This is the resulting graph, where we clearly can see if the pointers are to a left or right child node:

The illustration uses clustered nodes which are documented in e.g. graphviz.gitlab.io/pdf/dotguide.pdf, page 19 and 20.

We got the svg file by running these commands:

$ ./recreate-binary-tree-truly -g > tree1.dot
$ dot -Tsvg tree1.dot > tree1.svg

Then we can present the program, which is based on my invert-tree program from Challenge #57.1 Inverted Tree. It is quite long.

File: recreate-binary-tree-truly

#! /usr/bin/env raku

unit sub MAIN (Str $tree = '1 | 2 3 | 4 * 5 6 | * 7', :v($verbose), :g(:$graph));

my $sum = $tree.words.grep( * ~~ /\d/ ).sum;

say ": Sum: $sum" if $verbose;

class BinaryNode                       # [1]
{
  has Numeric    $.value  is rw;
  has BinaryNode $.left   is rw;
  has BinaryNode $.right  is rw;
}

my @btree = $tree.split("|")>>.words;  # [2]

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)); 
  }
}

my $btree = @new-nodes[0];

say ": { $btree.raku }\n" if $verbose;

traverse($btree);                          # [3]

say ": { $btree.raku }\n" if $verbose;

graph($btree) if $graph;                   # [4]

sub traverse ($current)                    # [3]
{
  $current.value = $sum - $current.value;

  traverse($current.left)  if $current.left.defined;
  traverse($current.right) if $current.right.defined;
}

sub graph ($graph)                        # [4]
{
  say 'digraph foogrph {';
  say '  node [shape = record,height=.1];';

  do-it($graph);

  say '}';

  sub do-it ($current)
  {
    say "  node{ $current.value }[label = \"<left> |<center> { $current.value }|<right> \"];";

    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);
    }
  }
}

[1] The «BinaryNode» class, with three values (the value, and a left and right child node pointer). All the values are declared «is rw» so that we can change them later on. (We are only going to change the value in this program, though.)

[2] See the explanation of the «invert tree» program for details.

[3] This procedure modifies the values.

[4] This procedure generates the graph.

Running it:

$ ./recreate-binary-tree-truly

The program builds up the tree, modifies tha values, and exits. Not very exiting…

Using the «-g» (graph) option gives us a Vizgraph graph declaration, that can be converted to other formats (as e.g. «svg»9 as we saw above).

$ ./recreate-binary-tree-truly -g
digraph foogrph {
  node [shape = record,height=.1];
  node27[label = "<left> |<center> 27|<right> "];
  "node27":left -> "node26":center;
  node26[label = "<left> |<center> 26|<right> "];
  "node26":left -> "node24":center;
  node24[label = "<left> |<center> 24|<right> "];
  "node24":right -> "node21":center;
  node21[label = "<left> |<center> 21|<right> "];
  "node27":right -> "node25":center;
  node25[label = "<left> |<center> 25|<right> "];
  "node25":left -> "node23":center;
  node23[label = "<left> |<center> 23|<right> "];
  "node25":right -> "node22":center;
  node22[label = "<left> |<center> 22|<right> "];
}

You may have spotted the problem, by now. I have used the node values as identifiers, and this will cause problems if we have duplicate values. E.g.

$ ./recreate-binary-tree-truly -g '1 | 2 3 | 4 * 5 6 | * 1' > tree2.dot
$ dot -Tsvg tree2.dot > tree2.svg

Oops indeed!

This is easy to fix.

File: recreate-binary-tree-truly2

#! /usr/bin/env raku

unit sub MAIN (Str $tree = '1 | 2 3 | 4 * 5 6 | * 7', :v($verbose), :g(:$graph));

my $sum = $tree.words.grep( * ~~ /\d/ ).sum;

say ": Sum: $sum" if $verbose;

class BinaryNode
{
  has Numeric    $.value  is rw;
  has BinaryNode $.left   is rw;
  has BinaryNode $.right  is rw;

  method id   # [1]
  {
    self.Str ~~ /(\d+)/; return $0.Str;
  }

  method sum  # [2]
  {
    my $sum = self.value;
    $sum += self.left.sum  if self.left.defined;
    $sum += self.right.sum if self.right.defined;
    return $sum;
  }
}

my @btree = $tree.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)); 
  }
}

my $btree = @new-nodes[0];

 say ": Sum: { $btree.sum }" if $verbose;

say ": { $btree.raku }\n" if $verbose;

traverse($btree);

say ": { $btree.raku }\n" if $verbose;

graph($btree) if $graph;

sub traverse ($current)
{
  $current.value = $sum - $current.value;

  traverse($current.left)  if $current.left.defined;
  traverse($current.right) if $current.right.defined;
}

sub graph ($graph)
{
  say 'digraph foogrph {';
  say '  node [shape = record,height=.1];';

  do-it($graph);

  say '}';

  sub do-it ($current)
  {
    say "  node{ $current.id }[label = \"<left> |<center> { $current.value }|<right> \"];";

    if $current.left.defined
    {
      say  "  \"node{ $current.id }\":left -> \"node{ $current.left.id }\":center;";  
      do-it($current.left);
    }

    if $current.right.defined
    {
      say  "  \"node{ $current.id }\":right -> \"node{ $current.right.id }\":center;";  
      do-it($current.right);
    }
  }
}

[1] This method gives a unique textual ID for each node, and we use that instead of the value when naming the nodes. This is based on the fact that Raku gives you the class name and a memory location (sort of) when you stringify an object (as discussed in Locate the Bell with Raku and Perl):

$ raku
> class ABC {}; my $a = ABC.new; say $a.Str;
ABC<94779351803648>

[2] At the same time, I rewrote the program to get the sum with this method (on the tree) instead of the initial string.

Running it:

$ ./recreate-binary-tree-truly -g '1 | 2 3 | 4 * 5 6 | * 1' > tree3.dot
$ dot -Tsvg tree3.dot > tree3.svg

Much better:

And that's it.

Links

About me
Keyword Index
Raku Courses
Beginning Raku (book)
RSS Feed
Code (zip)
Reddit Comments