RabbitFarm

2021-05-23

The Weekly Challenge 113

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.

posted at: 15:33 by: Adam Russell | path: /perl | permanent link to this entry

The Weekly Challenge 113 (Prolog Solutions)

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


:-initialization(main).

contains([], _, []).
contains([H|T], Digit, [N|R]):-
    number_chars(H, C),
    number_chars(Digit, [D]),
    member(D, C),
    N = H,
    contains(T, Digit, R).
contains([H|T], Digit, Contains):-
    number_chars(H, C),
    number_chars(Digit, [D]),
    \+ member(D, C),
    contains(T, Digit, Contains).

represented(N, D):-
    findall(X, between(1, N, X), Numbers),
    contains(Numbers, D, Contains),
    sum_list(Contains, N).

main:-
    (((represented(25, 7), write(1)); write(0)), nl),
    (((represented(24, 7), write(1)); write(0)), nl),
    halt.

Sample Run


$ gplc prolog/ch-1.p
$ prolog/ch-1
0
1

Notes

This is pretty straightforward Prolog. contains/3 is a list filter that gets the numbers from the list which contain Digit. After that is done we need only check to see if they sum to N. If represented/2 succeeds we print 1 and 0 otherwise.

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


:-dynamic(edge/3).

:-initialization(main).

root(1).
edge(old, 1, 2).
edge(old, 2, 4).
edge(old, 4, 7).
edge(old, 1, 3).
edge(old, 3, 5).
edge(old, 3, 6).

dfs_replace(GraphOld, GraphNew, Vertex):-
    dfs_replace(GraphOld, GraphNew, Vertex, _).
dfs_replace(GraphOld, GraphNew, Vertex, VertexPrevious):-
    (var(VertexPrevious),
     edge(GraphOld, Vertex, VertexNext),
     sum_remaining(GraphOld, Vertex, SumRemaining),
     dfs_replace(GraphOld, GraphNew, VertexNext, SumRemaining));
    sum_remaining(GraphOld, Vertex, SumRemaining),
    assertz(edge(GraphNew, VertexPrevious, SumRemaining)),
    findall(V, edge(GraphOld, _, V), VerticesOld),
    findall(V, edge(GraphNew, _, V), VerticesNew),
    length(VerticesOld, VOL),
    length(VerticesNew, VNL),
    VOL \== VNL,
    edge(GraphOld, Vertex, VertexNext),
    dfs_replace(GraphOld, GraphNew, VertexNext, SumRemaining).
dfs_replace(GraphOld, GraphNew, _, _):-
    findall(V, edge(GraphOld, _, V), VerticesOld),
    findall(V, edge(GraphNew, _, V), VerticesNew),
    length(VerticesOld, VOL),
    length(VerticesNew, VNL),
    VOL == VNL.

sum_remaining(GraphOld, Vertex, SumRemaining):-
    findall(V, edge(GraphOld, _, V), Vertices),
    root(Root),
    delete([Root|Vertices], Vertex, RemainingVertices),
    sum_list(RemainingVertices, SumRemaining).

main:-
    root(Root),
    dfs_replace(old, new, Root),
    listing(edge/3),
    halt.

Sample Run


$ gplc prolog/ch-2.p
$ prolog/ch-2

% file: /home/adamcrussell/Projects/perlweeklychallenge-club/challenge-113/adam-russell/prolog/ch-2.prolog

edge(old, 1, 2).
edge(old, 2, 4).
edge(old, 4, 7).
edge(old, 1, 3).
edge(old, 3, 5).
edge(old, 3, 6).
edge(new, 27, 26).
edge(new, 26, 24).
edge(new, 24, 21).
edge(new, 27, 25).
edge(new, 25, 23).
edge(new, 25, 22).

Notes

There are several ways to represent trees and graphs in Prolog. Here I chose to store the edges in the Prolog database along with a label containing the graph name. old is the original tree and new is the one containing the updated values fort eh vertices.

The overal approach is the same as I did for the Perl solution to this problem.

If we did not have the check on the number of updated vertices then dfs_replace/3 would simply fail when the traversal was complete. As thise code is designed this should instead succeed when complete.

References

Challenge 112

Depth First Traversal

posted at: 15:32 by: Adam Russell | path: /prolog | permanent link to this entry