path: root/challenge-113/james-smith/README.md

# Perl Weekly Challenge #113

You can find more information about this weeks, and previous weeks challenges at:

  https://perlweeklychallenge.org/

If you are not already doing the challenge - it is a good place to practise your
**perl** or **raku**. If it is not **perl** or **raku** you develop in - you can
submit solutions in whichever language you feel comfortable with.

You can find the solutions here on github at:

https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-113/james-smith/perl

# Challenge 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`.**

**Assumption** although not clear in the question, we make the
assumption that the numbers in the sum are all unique.

## Solution...

There are two classes of solution to this problem:

 1. Solutions where `$D` only appears in the right hand column.
 1. Solutions where `$D` appears in more than one column.

### Type 2 solutions...
If `$D` is 0. Then we can find solutions for all numbers `>=100`. For
the numbers `100` -> `109` the number itself surfices. For numbers
`>=110` we can always find a solution of the form (or similar):

```
   x x x x 0 x
+          x 0
```

If `$D` in not 0. Then we can find similar solutions for all numbers
`>= 10*$D`. Again for `10*$D` -> `10*$D + 9` the number itself surfices.
For numbers `>=11*$D` we have similar solutions to above where we can
write the nubmer as:

```
   x x x x D x
+          x D
```

So we check for that first, then we can look at the type (1) solutions

### Type 1 solutions...

We need a sequence of numbers `$D`, `10+$D`, `20+$D`, `30+$D` *etc*
that is less than or equal to `$N` and has the same last digit as `$N`.
Now we note `$D + 10+$D + 20+$D + 30+$D + 40+$D` is `100 + 5$D` and so
we know this is possible to represent for all values of `$D` so we
can ignore this case.

## Perl code

The first pass at this uses a for loop to generate the values of the
numbers in the sum. After first checking the criteria for type 2
solutions...

```perl
sub represent {
  my( $t, $n, $d ) = ( 0, @_ );
  ## Type 2 solutions...
  return 1 if $n >= 10 *A ( $d || 10 );
  ## Type 1 solutions...
  $n >= ( $t += $_ * 10 + $d ) &&
    ( $n % 10 == $t % 10 ) && return 1 for 0..3;
  0;
}
```

We can further improve performance by removing the need for the `$t`
variable and the `for` loop by "unrolling" the loop as below...

```perl
sub represent_unrolled {
  my( $n, $d ) = @_;
  ## Type 2 solutions...
  $n >= 10 * ( $d || 10 )            ||
  ## Type 1 solutions...
  $n >=   $d    && $n%10 == $d       ||
  $n >= 2*$d+10 && !( ($n-2*$d)%10 ) ||
  $n >= 3*$d+30 && !( ($n-3*$d)%10 ) ||
  $n >= 4*$d+60 && !( ($n-4*$d)%10 ) ? 1 : 0;
}
```

This appears to be 50% faster than the loop solution...

# Challenge 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.**

We already have an embryonic `Tree` object from the Linked list/tree
challenge in week 94.

So we will extend this (and to write a true `BinaryTree`) representation.

## Walk the tree

For each of the problems cloning, summing, updating a tree we need to
walk the tree. The solution I propose here will define a "walking"
function on the tree, which has it's parameters:

  * a function to handle each node
  * a "global" storage object
  * a "local" storage object
  * whether the node is a left child / right child.

## Perl `BinaryTree` object.

Our binary tree is represented by an array of length 3. The value of
the node {which can be any object} and the left and right children.

We then have two methods - `add_left_child` and `add_right_child` to
add them to the tree.

We also have accessors:

 * `left` - left child
 * `right` - right child
 * `value` - value of node

We have to functions to check for existance of a child:

 * `has_left` - left child
 * `has_right` - right child

and finally a method to update a node `update`

```perl
package BinaryTree;

sub new {
  my $class = shift;
  my $value = shift;
  my $self = [ $value, undef, undef ];
  bless $self, $class;
}

sub update {
  my( $self, $val ) = @_;
  $self->[0] = $val;
  return $self;
}

sub value {
  my $self = shift;
  return $self->[0];
}

sub add_child_left {
  my( $self,$child ) = @_;
  $self->[1] = $child;
  return $self;
}

sub add_child_right {
  my( $self,$child ) = @_;
  $self->[2] = $child;
  return $self;
}

sub left {
  my $self = shift;
  return $self->[1];
}

sub right {
  my $self = shift;
  return $self->[2];
}

sub has_left {
  my $self = shift;
  return defined $self->[1];
}

sub has_right {
  my $self = shift;
  return defined $self->[2];
}

```

## Walking the tree...

Our tree walking function takes up to 4 parameters:

 1. `$fn` a callback function which does whatever is needed,
    e.g. collect summary statistics, update the node etc;
 1. `$global` a reference to a variable which is used as
    "global" storage for the walk
 1. `$local` a variable which is used as "local" storage for the walk,
    it is updated as the value from `$fn` before being passed to the
    children,
 1. `$dir` the direction of the walk whether it be "left" or "right"

`$self`, `$global`, `$local` and `$dir` are all passed to the callback
function....

The code itself is quite simple to look at...

```perl
sub walk {
  my( $self, $fn, $global, $local, $dir ) = @_;
  $local = $fn->( $self, $global, $local, $dir||'' );
  $self->left->walk(  $fn, $global, $local, 'left'  ) if $self->has_left;
  $self->right->walk( $fn, $global, $local, 'right' ) if $self->has_right;
  return;
}
```

## Cloning - with walk 

```perl
sub clone {
  my( $self, $clone_fn ) = @_;
  $clone_fn ||= sub { $_[0] };
  my $clone = {};
  $self->walk( sub { my( $node, $global, $local, $dir ) = @_;
    if(exists $global->{'tree'} ) {
      my $child = BinaryTree->new( $clone_fn->( $node->value ) );
      $dir eq 'left' ? $local->add_child_left( $child ) : $local->add_child_right( $child );
      return $child;
    }
    $global->{'tree'} = BinaryTree->new( $clone_fn->( $node->value ) );
    return $global->{'tree'};
  }, $clone );
  return $clone->{'tree'};
}
```
We can use this `walk` method to clone our tree.
Global is a hashref with one entry - 'tree' which will contain our
cloned tree.

The first time through the loop it initialises the tree and adds the
root node to the tree and returns itself. `$local` is then this node.

For subsequent calls the tree exists and so a new BinaryTree objects is
produced and attached to it's parent (which is held in `$local`) either
as a left or right child.

`clone` can take an additional `callback` which is applied to each
node when being copied - which defaults to just a straight copy.

There are two more "walk methods" in the object, which dump the data:
either as a single line of values (flatten) or as "ASCII-art" to show
the nodes and their relationships.

```perl
sub flatten {
  my( $self,$dump_fn ) = @_;
  $dump_fn ||= sub { $_[0] };
  my $arrayref = [];
  $self->walk( sub {
    my($node,$global) = @_;
    push @{$global}, $dump_fn->( $node->value );
  }, $arrayref );
  return @{$arrayref};
}

sub dump {
  my( $self, $dump_fn ) = @_;
  $dump_fn ||= sub { $_[0] };
  $self->walk( sub {
    my( $node, $global, $local, $dir ) = @_;
    say join '',
        $local||'',
        $dir eq 'left' ? '<' : $dir eq 'right' ? '>' : ' ',
        ' ', $dump_fn->($node->value);
    return $local .= '  ';
  }, {}, '', '' );
  return;
}
```

Like clone they take a simple call back if you want to include a
function of the object's values rather than the value itself....
*a callback* within *a callback*.... You could even say its
***Turtles all the way down***...

## The solution

### Walking the tree to get the sum

We create a "*global*` variable which contains the total, walk through
all nodes and add the node value to this total.... We can then
retrieve the value by inspecting `$glob`..

```perl
my $glob = { 'total' => 0 };
$y->walk( sub {
  my( $node, $global ) = @_;
  $global->{'total'} += $node->value;
}, $glob );
```

### Walking the tree to update the nodes...

We pass the variable $glob back in, and use the total there
to update the value. For the value to be the sum of all the
other nodes, we can get this by adding all the nodes together
than subtracting away the node value....

So the 2nd half becomes.
```perl
$y->walk( sub {
  my( $node, $global ) = @_;
  $node->update( $global->{'total'} - $node->value );
}, $glob );
```