RabbitFarm

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

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.

Solution

use strict;
use warnings;
sub is_represented{
    my($n, $d) = @_;
    my @contains = grep { grep { $_ == $d } split(//) } (1 .. $n);
    return $n == unpack("%32C*", pack("C*",  @contains));
}

MAIN:{
    print is_represented(25, 7) + 0 . "\n";
    print is_represented(24, 7) + 0 . "\n";
}

Sample Run

$ perl perl/ch-1.pl
0
1

Notes

I've been trying to avoid using regexes in these challenges recently, to help promote some increased creativity. Here I use a nested grep to determine which numbers contain the digit $d.

I also use one of my favorite ways to sum a list of numbers using unpack and pack!

By default the false value in the first example will print as an empty string. The + 0 forces a numification to 0 (or 1 too) which then stringifies to what we expect.

Part 2

You are given a Binary Tree. Write a script to replace each node of the tree with the sum of all the remaining nodes.

Solution

use strict;
use warnings;
use Graph;
use Graph::Easy::Parser;

sub dfs_update{
    my($graph, $vertex, $graph_updated, $previous) = @_;
    my @successors = $graph->successors($vertex);
    for my $successor (@successors){
        my $sum_remaining = sum_remaining($graph, $vertex);
        $graph_updated->add_edge($previous, $sum_remaining) if $previous;
        dfs_update($graph, $successor, $graph_updated, $sum_remaining);
    }
    $graph_updated->add_edge($previous, sum_remaining($graph, $vertex)) if !@successors;
}

sub sum_remaining{
    my($graph, $visited) = @_;
    my $sum = 0;
    for my $vertex ($graph->vertices()){
        $sum += $vertex if $vertex != $visited;
    }
    return $sum;
}

sub display_graph{
    my($graph) = @_;
    my $s = $graph->stringify();
    my @s = split(/,/, $s);
    my @lines;
    for my $n (@s){
        my @a = split(/-/, $n);
        push @lines, "[ $a[0] ] => [ $a[1] ]";
    }
    my $parser = new Graph::Easy::Parser();
    my $graph_viz = $parser->from_text(join("", @lines));
    print $graph_viz->as_ascii();
}

MAIN:{
    my $graph = new Graph();
    my $graph_updated = new Graph();
    my $root = 1;
    $graph->add_edge($root, 2);
    $graph->add_edge($root, 3);
    $graph->add_edge(2, 4);
    $graph->add_edge(4, 7);
    $graph->add_edge(3, 5);
    $graph->add_edge(3, 6);
    dfs_update($graph, $root, $graph_updated);
    display_graph($graph);
    display_graph($graph_updated);
}

Sample Run

$ perl perl/ch-2.pl
+---+     +---+     +---+     +---+
| 1 | ==> | 2 | ==> | 4 | ==> | 7 |
+---+     +---+     +---+     +---+
  H
  H
  v
+---+     +---+
| 3 | ==> | 5 |
+---+     +---+
  H
  H
  v
+---+
| 6 |
+---+
+----+     +----+     +----+     +----+
| 27 | ==> | 26 | ==> | 24 | ==> | 21 |
+----+     +----+     +----+     +----+
  H
  H
  v
+----+     +----+
| 25 | ==> | 22 |
+----+     +----+
  H
  H
  v
+----+
| 23 |
+----+

Notes

Whenever I work these sort of problems with Trees and Graphs I use the Graph module. My main motivation is to maintain a consistent interface so the code I write is more re-usable for the many problems that can be solved using a graph based approach. The problem at hand is a clear candidate as it is explicitly stated as such. Sometimes, however, graph problems are somewhat in disguise although the use of a graph representation will yield the best solution.

The core of the solution is done via a Depth First traversal of the tree. Each vertex, as it is visited is used to generate a new edge on a tree constructed with the conditions of the problem statement.

The original and updated trees are visualized with Graph::Easy.

References

Challenge 113

Depth First Traversal

Mastering Algorithms with Perl is an excellent book with a very in depth chapter on Graphs.