RogerBW's Blog

I’ve been doing the Perl Weekly Challenges. The latest involved chained strings and number construction. (Note that this is open until 6 June 2021.)

TASK #1 › String Chain

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.

In other words, can you by changing the order of the strings arrange them so that for each adjacent pair the last character of the first is the first character of the next – with a wrap round at the end?

This isn't really a part 1 question, because of two extra cases that make it distinctly less trivial:

• There might be two separate cycles (e.g. abc dea fgh hif), so merely counting and matching string starts and ends won't work.
• There might be one cycle but multiple ways of assembling the sequence (e.g. abc cgd dec cfa), of which only some are valid – so using a simple hash table that maps starts to ends won't work.

So one approach would be to permute and filter the strings, but I've done permutation searches, so I thought I'd try something a bit more specific to this particular problem.

sub sc {
  my @n=@_;

I ended up building two structures: m is a list of final characters of strings (same index numbers as the strings themselves), and i is a hash (keyed on first characters) of lists of indices of strings starting with those characters. So in the first test case (abc dea cd), m is [c,a,d], and i is {a => [0], d => [1], c => [2]}.

  my @m;
  my %i;
  foreach my $t (@n) {
    push @m,substr($t,-1,1);
    push @{$i{substr($t,0,1)}},$#m;
  }

chain is the search path, containing a list of lists of indices.

  my @chain=([0]);

Each time I look at extending the path, I pull the last entry off the chain (we don't care whether we're depth-first or breadth-first here), then construct a list of valid indices that might extend it – i.e. all the indices that it doesn't already use. If there are none left, we have used each element once.

  while (@chain) {
    my $stub=pop @chain;
    my %v=map {$_ => 1} (0..$#n);
    map {delete $v{$_}} @{$stub};

If there are any valid extensions, see if any of them matches the last character of the current path, and continue.

    if (%v) {
      if (exists $i{$m[$stub->[-1]]}) {
        my @x=grep {exists $v{$_}} @{$i{$m[$stub->[-1]]}};
        foreach my $x (@x) {
          push @chain,[@{$stub},$x];
        }
      }

Otherwise we might have an actual solution. We've used all the pieces; did we get back to where we started? (This was a bug in my original code.)

    } else {
      if (exists $i{$m[$stub->[-1]]} && $i{$m[$stub->[-1]]}[0]==0) {
        return 1;
      }
    }
  }
  return 0;
}

Not much to see in the other languages, except that they have sets (hashes that just have keys, not values), which I use for v.

TASK #2 › Largest Multiple

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.

Well, there's a simple optimisation here that beats brute force (a bit like last week's part 2): put the lowest even character at the right-hand end of the string to make the result even, and sort the rest into descending order.

Only one extra test case this time: what if no even number can be constructed at all? (I choose to return 0.)

List::MoreUtils has firstidx to do this in one operation in Perl, but that's not a core module; in the other languages I was able to extract both index and value in a single operation. Overall this turned out to be rather less work than part 1 was, in fact. Raku:

sub lm(**@n) {
  my @o=sort @n;
  my ($i,$t)=@o.first({$_ % 2 == 0}, :kv);
  unless (defined $i) {
    return 0;
  }
  splice @o,$i,1;
  @o=reverse @o;
  push @o,$t;
  return join('',@o);
}

The other languages work similarly, with more or less complication (especially if they don't have an equivalent of splice and you have to build up the output piece by piece).

Full code on github.