# Perl Weekly Challenge 115.

My solutions (task 1, task 1a, task 1b, and task 2) to the The Weekly Challenge - 115.

# Task 1: String Chain

```
Submitted by: Mohammad S Anwar
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.
Examples:
Input: @S = ("abc", "dea", "cd")
Output: 1 as we can form circle e.g. "abc", "cd", "dea".
Input: @S = ("ade", "cbd", "fgh")
Output: 0 as we can't form circle.
```

I will assume that all the strings have to participate exactly once in the circle.

## Connectivity matrix (almost correct)

There is a nice solution (see 1.4) to this task using matrices. I define a
connectivity matrix *C _{ij}* which has the value 0 if string

*i*can follow string

*j*and is zero otherwise. If I multiply this matrix by a column vector

*K*which has the value 1 at position

_{k}*j=k*and the value 0 elsewhere, then I obtain a vector with a 1 at the positions corresponding to each string that can be reached from the

*k*-th string and 0 elsewhere. If I act with

*C*on the result, I would get a vector with a 1 or a 2 at each position that may be reached by traveling two steps from string

*k*, and zero elsewhere. The result 2 corresponds to those strings that may be reached following two different paths, and the result 1 to strings that can only be reached along a unique two-step path. Thus, the entry

*ij*of the matrix

*C× C*is the number of paths that can start at

*j*and reach

*i*in two steps. Analogously,

*C× C× C…*repeated

*n*times has entries

*ij*showing the number of paths that start at

*j*and end at

*i*after

*n*steps. A problem with this approach is that I may count paths that return to a starting position several times. To avoid this, I have to eliminate the diagonal elements before multiplication. Thus I define a set of new matrices as follows:

*D*is

^{(1)}*C*after setting its diagonal elements to zero. Then I define recursively

*D*as

^{(n)}*E*with its diagonal elements set to zero, where

^{(n)}*E*. I can make a cycle that visits every string if starting at any position

^{(n)}=D^{(n-1)}× D^{(1)}*j*, give

*N-1*steps and return to

*j*without having repeated any other site, that is, if

*E*for all

^{(N)}_{jj}≠ 0*j*.

To manipulate the matrices I use the *Perl Data Language*.

To find out which string is connected to which other we just have to check their first and last letters.

```
# Perl weekly challenge 115
# Task 1: String Chain. Connectivity matrix solution. Not quite correct.
#
# See https://wlmb.github.io/2021/06/01/PWC115/#task-1-string-chain
use strict;
use warnings;
use v5.12;
use List::Util qw(reduce);
use PDL;
my @strings=@ARGV;
die "Usage ./ch-1.pl string1 [string2...]" unless @strings;
my $C=zeroes(long,scalar(@strings), scalar(@strings)); #connectivity matrix
map {my $f=$_;map {$C->slice("$f,$_").=follows($f, $_)}
(0..@strings-1)}(0..@strings-1);
my $R=reduce {map{$_->diagonal(0,1).=0}($a, $b); $b x $a;}
($C) x @strings;
say "Input: ", join " ", @strings;
say "Output: ", all($R->diagonal(0,1)>0);
sub follows {
my ($from, $to)=map {$strings[$_]} @_;
return substr($from,-1,1) eq substr($to,0,1);
}
```

Examples:

```
./ch-1.pl abc dea cd
./ch-1.pl ade cbd fgh
```

Results:

```
Input: abc dea cd
Output: 1
Input: ade cbd fgh
Output: 0
```

as expected from the description of the task.

Two cases with two short independent loops, inconmesurate in one case and conmesurate in the other:

```
./ch-1.pl ab bc ca de ed
./ch-1.pl ab bc ca de ef fd
```

Results:

```
Input: ab bc ca de ed
Output: 0
Input: ab bc ca de ef fd
Output: 0
```

In the first case, at the end of five steps no string went back to itself. In the second case, at the end of six steps all strings have gone back to themselves twice, but as the program eliminates early returns to the starting positions, the circle cannot be formed.

A similar case, connecting the loops:

```
./ch-1.pl ab bc ca de ed cd dc
```

Results:

```
Input: ab bc ca de ed cd dc
Output: 1
```

In the case, we do have a circle: `ab-bc-cd-de-ed-dc-ca-repeat`

.

An example with just one string:

```
./ch-1.pl aa
```

Results:

```
Input: aa
Output: 1
```

as `aa-repeat`

may be considered as a circle of length one. Note the trick
for this special case: `reduce`

returns `$C`

without further
processing, i.e., without zeroing the diagonal, when there is only one node.

An ambiguous case:

```
./ch-1.pl ab ba ab ba
```

Results:

```
Input: ab ba ab ba
Output: 1
```

as I didn’t demand unique strings, so I consider, for example, the
second `ab`

as different from the first. Thus, I have the circle
*ab _{1}-ba_{1}-ab_{2}-ba_{2}-repeat*. If desired, it would be easy to filter out
repeated strings. If I demand unique strings, I can replace the
example above to

```
./ch-1.pl axb bxa ayb bya
```

Results:

```
Input: axb bxa ayb bya
Output: 1
```

Notice that in this case there is more than one circle:
`axb-bxa-ayb-bya-repeat`

and `axb-bya-ayb-bxa-repeat`

.

I found that it is actually unnecesary to remove the diagonal from
`$b`

in the line

```
my $R=reduce {map{$_->diagonal(0,1).=0}($a, $b); $b x $a;}
($C) x @strings;
```

as it was meant to prevent returning immediately to the same
string. Nevertheless, the program does allow returning to the same
position after more than one step as long as it is not the starting position. It
is for this reason that it is important to check that *all* the
diagonal elements are non-zero. Otherwise, we would only check that
there is a cycle of the correct length, but it may consist of more
than one short circle and it may not visit all strings.

## Build the actual circle

The program above doesn’t display the actual circle, it just states
that it exists or that it doesn’t. If we want to display an actual
circle we can build all viable paths of
*n+1* strings from those of *n* strings by adding all possible
followers, pruning out early cycles.

```
# Perl weekly challenge 115
# Task 1: String Chain. Build the circle.
#
# See https://wlmb.github.io/2021/06/01/PWC115/#task-1-string-chain
use strict;
use warnings;
use v5.12;
use List::Util qw(first any);
my @strings=@ARGV;
die "Usage ./ch-1.pl string1 [string2...]" unless @strings;
my %followers;
map {my $f=$_;
$followers{$f}=[];
map {push @{$followers{$f}}, $_ if follows($f, $_)}@strings
} @strings;
my @paths=([$strings[0]]);
foreach (1..@strings-1){
@paths=grow(@paths);
}
say "Input: ", join " ", @strings;
my $path=first {follows($_->[-1], $_->[0])} @paths;
say "Output: ", defined $path?1:0;
say "Path: ", join "-", @$path if defined $path;
sub follows {
my ($from, $to)=@_;
return substr($from,-1,1) eq substr($to,0,1);
}
sub grow {
my @paths=@_;
my @new;
push @new, grow_one($_) for @paths;
return @new;
}
sub grow_one {
my $path=shift;
my @new=grep {defined $_} map {add_to($path, $_)} @{$followers{$path->[-1]}};
return @new;
}
sub add_to {
my ($path, $string)=@_;
return if any {$_ eq $string} @$path; # don't add duplicates
my @new=@$path; #copy
push @new, $string;
return [@new];
}
```

Examples:

```
./ch-1a.pl abc dea cd
./ch-1a.pl ade cbd fgh
./ch-1a.pl ab bc ca de ed
./ch-1a.pl ab bc ca de ef fd
./ch-1a.pl ab bc ca de ed cd dc
./ch-1a.pl aa
./ch-1a.pl ab ba ab ba
./ch-1a.pl axb bxa ayb bya
```

Results:

```
Input: abc dea cd
Output: 1
Path: abc-cd-dea
Input: ade cbd fgh
Output: 0
Input: ab bc ca de ed
Output: 0
Input: ab bc ca de ef fd
Output: 0
Input: ab bc ca de ed cd dc
Output: 1
Path: ab-bc-cd-de-ed-dc-ca
Input: aa
Output: 1
Path: aa
Input: ab ba ab ba
Output: 0
Input: axb bxa ayb bya
Output: 1
Path: axb-bxa-ayb-bya
```

Notice that this program agrees with the previous one except for the
case `ab ba ab ba`

, as it doesn’t consider repeated strings to differ,
i.e., the second `ab`

is `eq`

to the first. The reason is that here
we refer to a string by its actual value, while in the former program we
refered to it through its index in the array of strings.

## Königsberg bridges

The directed graphs corresponding to this problem have a
peculiarity. The nodes may be grouped into equivalence classes
according to the starting (or ending) letter. All nodes that connect
to a member of a class, are also connected to all the remaining
members of the class. Thus, I can make another graph where each node
corresponds to an equivalence class, i.e., to a letter.
A mathematician (my son) suggested that the problem could be mapped to
that of the Königsberg (directed) bridges if I make a graph where the
land areas (the nodes) correspond to the the first and last letters, and the
bridges (the edges) correspond to the words that connect the first
letter to the last. Then the circle could be found if, for each node, the number of
incoming and outgoing edges coincide, and if the graph is not
disjoint. The connectivity of the graph can be checked by multiplying
the identity matrix by the connectivity matrix from 0 to *N-1* times, where
*N* is the number of nodes and checking that all matrix elements
are non-zero in at least one of the resuling matrices.

```
# Perl weekly challenge 115
# Task 1: String Chain. Königsberg bridges solution
#
# See https://wlmb.github.io/2021/06/01/PWC115/#task-1-string-chain
use strict;
use warnings;
use v5.12;
use Exporter::Renaming; # prevent name clashes
use List::Util Renaming=>[uniq=>'lu_uniq', reduce=>'lu_reduce', reductions=>undef];
use PDL;
use PDL::NiceSlice;
my @strings=@ARGV;
die "Usage ./ch-1.pl string1 [string2...]" unless @strings;
my @letters=lu_uniq map{(substr($_,0,1), substr($_,-1,1))} @strings;
my %index;
@index{@letters}=(0..@letters-1);
my $C=zeroes(scalar(@letters), scalar(@letters)); #connectivity matrix
$C->($_->[0],$_->[1]).=$C->($_->[0],$_->[1])+1
foreach map { [$index{substr($_,0,1)},$index{substr($_,-1,1)}] } @strings;
my $balanced=all($C->sumover==$C->transpose->sumover);
my $final=lu_reduce {$a|$b} (reductions {$a x $b} (identity(scalar @letters), ($C) x (@letters-1)));
my $reachable=all($final!=0);
say "Input: ", join " ", @strings;
say "Output: ", $balanced &&$reachable? 1:0;
```

Examples:

```
./ch-1b.pl abc dea cd
./ch-1b.pl ade cbd fgh
./ch-1b.pl ab bc ca de ed
./ch-1b.pl ab bc ca de ef fd
./ch-1b.pl ab bc ca de ed cd dc
./ch-1b.pl aa
./ch-1b.pl axb bxa ayb bya
```

Results:

```
Input: abc dea cd
Output: 1
Input: ade cbd fgh
Output: 0
Input: ab bc ca de ed
Output: 0
Input: ab bc ca de ef fd
Output: 0
Input: ab bc ca de ed cd dc
Output: 1
Input: aa
Output: 1
Input: ab ba ab ba
Output: 1
Input: axb bxa ayb bya
Output: 1
```

The results agree with those of the previous solutions.

## Counterexample

Actually, I was not completely sure my first solution would work for all possible inputs, but I couldn’t find an example where it failed. After submitting the first versions of my solutions, my mathematician son helped me find it. The following example with twelve words has two unconnected sets of words: those that start with a or b or c, and those that start with d or e or f. Thus it is impossible to make a circuit that visits all of the words. Nevertheless, each subset has trajectories that, starting from any word, loops around several times without returning to the initial word until after twelve steps, thus fooling my program.

```
./ch-1.pl axb ayb bxc byc cxa cya dxe dye exf eyf fxd fyd
./ch-1a.pl axb ayb bxc byc cxa cya dxe dye exf eyf fxd fyd
./ch-1b.pl axb ayb bxc byc cxa cya dxe dye exf eyf fxd fyd
```

Results:

```
Input: axb ayb bxc byc cxa cya dxe dye exf eyf fxd fyd
Output: 1
Input: axb ayb bxc byc cxa cya dxe dye exf eyf fxd fyd
Output: 0
Input: axb ayb bxc byc cxa cya dxe dye exf eyf fxd fyd
Output: 0
```

Clearly, the first program gives the wrong result.

# Task 2: Largest Multiple

```
Submitted by: Mohammad S Anwar
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.
Examples
Input: @N = (1, 0, 2, 6)
Output: 6210
Input: @N = (1, 4, 2, 8)
Output: 8412
Input: @N = (4, 1, 7, 6)
Output: 7614
```

This seems very simple. The least significant digit should be the smallest even number, as that makes the full number even. The rest of the digits should increase from least to most significant to get the largest digits multiplied by the largest powers of 10. I admit repeated digits.

```
# Perl weekly challenge 115
# Task 2: Largest Multiple
#
# See https://wlmb.github.io/2021/06/01/PWC115/#task-2-largest-multiple
use strict;
use warnings;
use v5.12;
use List::MoreUtils qw(first_index);
foreach(@ARGV){
die "Usage: ./ch-2.pl digits1 [digits2...]"
unless m/^\d+$/;
say "Input: $_";
my @digits=sort {$a<=>$b} split '', $_;
my $even_index=first_index {$_%2==0} @digits;
say("No even number may be constructed from input"), next
unless $even_index>=0;
my $last=splice @digits, $even_index,1;
say "Output: ", reverse(@digits), $last;
}
```

Examples

```
./ch-2.pl 1026 1428 4176 13579
```

Results:

```
Input: 1026
Output: 6210
Input: 1428
Output: 8412
Input: 4176
Output: 7614
Input: 13579
No even number may be constructed from input
```