RabbitFarm

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

Part 1

You are given an array of strings. Write a script to find out if the given strings can be chained to form a circle. Print 1 if found otherwise 0. A string $S can be put before another string $T in circle if the last character of $S is same as first character of $T.

Solution

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

sub build_graph{
    my @words;
    my %first_letter_name;
    my $graph = new Graph();
    while(my $s = ){
        chomp($s);
        my $first_letter = substr($s, 0, 1);
        if($first_letter_name{$first_letter}){
            push @{$first_letter_name{$first_letter}}, $s;
        }
        else{
            $first_letter_name{$first_letter} = [$s];
        }
        push @words, $s;
    }
    for my $word (@words){
        $graph->add_vertex($word) if !$graph->has_vertex($word);
        my $child_nodes = $first_letter_name{substr($word, -1)};
        for my $n (@{$child_nodes}){
            $graph->add_vertex($n) if !$graph->has_vertex($n);
            $graph->add_weighted_edge($word, $n, (-1 * length($n))) if !$graph->has_edge($word, $n);
            $graph->delete_edge($word, $n) if $graph->has_a_cycle();
        }
    }
    return $graph;
}

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] ] => [ ]" if @a == 1;
        push @lines, "[ $a[0] ] => [ $a[1] ]" if @a > 1;
    }
    my $parser = new Graph::Easy::Parser();
    my $graph_viz = $parser->from_text(join("", @lines));
    print $graph_viz->as_ascii();
}

MAIN:{
    my $graph = build_graph();
    my @cc = $graph->weakly_connected_components();
    print "1\n" if @cc == 1;
    print "0\n" if @cc != 1;
    display_graph($graph);
}

__DATA__
ab
bea
cd

Sample Run

$ perl perl/ch-1.pl
0
+----+     +-----+
| ab | ==> | bea |
+----+     +-----+
+----+
| cd | ==>
+----+
$ perl perl/ch-1.pl
1
+-----+     +-----+     +----+
| dea | ==> | abc | ==> | cd |
+-----+     +-----+     +----+

Notes

Task #1 is very similar to the Pokemon Name Ladder task from Challenge 025. This task is actually a part of that previous challenge in that here we do not need to compute the longest possible chain of strings; we just need to confirm that the chain exists.

The approach here is:

• read in the words and construct the directed graph
• check to see that the number of connected components is one. If so, print 1. Otherwise print 0.
• display the graph (an optional data visualization step)

The function used to determine the number of connected components is weakly_connected_components(). This is because the chain is constructed as a directed graph and the idea of a connected component is defined for undirected graphs. Weakly connected components are determined by whether or not the nodes are connected if we ignore the direction of the edges. This is what we want for our use case here, as opposed to strongly connected components. To determine strongly connected components we would need bi-directional edges for each link in the chain. No need to overcomplicate this with extra edges...the desired result is obtained just fine as is!

In the example output the first run shows two connected components, therefor no chain exists. In the second output the chain is shown, there is one connected component.

Part 2

You are given a list of positive integers (0-9), single digit. Write a script to find the largest multiple of 2 that can be formed from the list.

Solution

use strict;
use warnings;
sub largest_multiple_2{
    my @numbers = @_;
    return unless grep { $_ % 2 == 0 } @numbers;
    my @sorted = sort {$b <=> $a} @numbers;
    if(@sorted >= 2){
        my $ultima = @sorted[@sorted - 1];
        if($ultima % 2 != 0){
            my $swap_index = -1;
            for(my $i = @sorted - 2; $i >= 0; $i--){
                $swap_index = $i if $sorted[$i] % 2 == 0;
                last if $swap_index > 0;
            }
            $sorted[@sorted - 1] = $sorted[$swap_index];
            $sorted[$swap_index] = $ultima;
        }
    }
    return join("", @sorted);
}

MAIN:{
    my @N;
    @N = (1, 0, 2, 6);
    print largest_multiple_2(@N) . "\n";
    @N = (1, 4, 2, 8);
    print largest_multiple_2(@N) . "\n";
    @N = (4, 1, 7, 6);
    print largest_multiple_2(@N) . "\n";
}

Sample Run

$ perl perl/ch-2.pl
6210
8412
7614

Notes

Suppose we did not have the "multiple of 2" restriction and instead had to arrange a list of numbers to have maximal value when concatenated together. The solution, then, would be to sort the numbers in descending order and concatenate the digits in this sorted order.

Here we can still use that same logic but more care is needed.

First, let's remind ourselves that we can check to see if any number is a multiple of 2 by checking if it's rightmost digit is a multiple of 2 (including 0).

• We need to make sure we have at least one digit which is a multiple of 2. If not, then there is no need to continue.
• Sort the numbers, but then inspect the final digit in descending order. Is it a multiple of 2? If so, then we are done!
• If the final digit is not a multiple of 2 then search the sorted list starting from the final digit and working "upwards". We had previously made sure we had at least one multiple of 2 so we are certain to find one. When we find it we need to swap it with the final digit to insure that the entire number itself is a multiple of 2.

References

Challenge 115

Pokemon Name Ladder

Weakly Connected Component