An Even Larger String Cheese Chain

Wherein we find what keys fit what locks, what links hold the team together and how we can rearrange reality to our maximum advantage in a tight spot.

THE WEEKLY CHALLENGE – PERL & RAKU #115

---

episode one:
“The Incident”

---

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.

Method

This task is perhaps more complex than it might at first appear, as there seems to be no limit on either the strings or their letters. In theory it could become quite complicated, with multiple strings starting or ending with the same letter, giving multiple pathway options that will all need to be explored.

Although not expressly stated, I’m going to assume every string will need to be connected in this chain. Finding the longest chain we could make would be another, different problem with a lot more complexity still.

When contemplating all this potential complexity, one aspect that does work in our favor is the circle: we only care if all the strings can be chained, so consequently the circle is equivalent at all its links. This in turn means we can start constructing the chain at any point, so we can pick whatever spot is easiest. No spot is better or worse than any other.

Therefore we’ll simply start at the beginning of the list and attempt to build a chain. Looking at the first string, we’ll add it to the chain, and examine the last character. We then filter the array using grep to find all remaining strings that start with the same letter. As we don’t yet know how many pathways we’ll need to check before we start, a recursive algorithm fits well for the next part.

For each of the options we find we will try adding it to a new copy of the partial chain and removing it from the list of remaining possibilities. The partial solution and new set of possibilities are then passed along recursively, repeating until either a contradiction is found or we complete the chain.

The base case for the recursion is when there are no more valid possibilities to link to; this can happen in a few different ways. When it does happen, if the remaining list is still has anything unused in it the chain has failed to link all the strings. However even if we’ve linked the last string we’re not quite done, as we still need to see whether we can link to the first character in the first element to complete the circle.

If we find the last string can link to our first element then we have discovered the complete chain.

PERL 5 SOLUTION

[colincrain@boris:~/Code/PWC]$  perl 115-1-string_cheese.pl abc gba efg abc gca cdg cde
abc cdg gba abc cde efg gca

In the recursion, the routine is handed a partial chain and a set of remaining strings to be chained. We have several base cases:

• If we run out of strings in the remaining pool, we return with one of two possibilities:
  • if we link up to the beginning we join the chain we’ve built and return that string
  • if we can’t link we fail and return undef
• If when looking to find strings that can continue the chain we don’t find any, and there are more strings in the pool we have failed and return undef
• If we recurse and the recursion routine returns something defined we pass it through and return it immediately
• If we run out of options we fail and return undef

We call the routine and if it returns a solution we print it, or alternately print “none”. I think this is a little more interesting than 1/0 result requested.

use warnings;
use strict;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';
use List::Util qw( first );

my @str = @ARGV;

if (scalar @str) {
    my $res = chain(\@str);
    say $res? $res : "no chain";
}

sub chain ($strings, $chain = []) {
    $chain->[0] = shift $strings->@* if not defined $chain->[0];
    
    ## base: if no more in pool check last loop link
    if (scalar $strings->@* == 0) {
        return join ' ', $chain->@* 
            if substr($chain->[-1], -1) eq substr($chain->[0], 0, 1);
        return undef;
    }

    my @next = grep { substr($chain->[-1], -1) eq substr($_, 0, 1) } $strings->@*;

    ## base: no next link and still more in pool fails
    return undef if @next == 0 and $strings->@* > 0;
    
    for my $link (@next) {
        my @possible = $strings->@*;
        my $idx = first { $possible[$_] eq $link } (0..$#possible);
        splice @possible, $idx, 1;
        
        my $result = chain( \@possible, [ $chain->@*, $link ] );

        return $result if defined $result;
    }
    return undef;
}

raku solution

In Raku we’ll gloss over over the I/O portion and run a series of tests on our routine. Many of the conditionals have tightened up nicely and the flow is very discreet and clear. I find Raku sometimes very easy to read. Although it give us the power to make very complex, very powerful lines for processing that doesn’t necessarily mean we should.

Note the adverb modifying .first() to have it return the key, rather than the value. We’ll see this again in the next task.

unit sub MAIN () ;

use Test;
plan 5;
is chain(["abc", "dea", "cd" ])       , "abc cd dea",       'ex-1';
is chain(["ade", "cbd", "fgh"])       , Nil,                'ex-2';
is chain(["abc", "dea", "cda"])       , Nil,                'short loop';
is chain(["abc", "aea", "cda"])       , "abc cda aea",      'multi first';
is chain(["abc", "abc", "cda", "cda"]), "abc cda abc cda",  'repeats';

sub chain (@str, *@chain) {
    @chain.unshift(@str.shift) unless @chain.elems;
    
    ## base case: if no more in pool check last loop link
    if @str == 0 {
        return @chain[*-1].substr(*-1) eq @chain[0].substr(0,1)
            ?? @chain.join(' ')
            !! Nil;
    }
 
    my @next = @str.grep({@chain[*-1].substr(*-1,1) eq $_.substr(0,1)}) ;

    ## base case: no next link and still more in pool fails
    return Nil if @next ~~ Empty and @str.elems;
    
    for @next -> $link {
        my @possible = @str;
        splice @possible, @possible.first(* eq $link, :k), 1;
        my $result = chain( @possible, |@chain, $link );
        return $result if $result.defined;
    }
    return Nil;
}

---

episode two:
“List One Perl Two”

---

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

Method

What make a number large? I’ll tell you what: large digits, that’s what. Big, powerful, higher-valued digits. Nines, eights, the odd seven — that sort of thing. Vigorous, red-blooded, virile leaders of numbers. Digits you respect, digits that respect you. Digits you want on your side in a fight.

Given a diverse team with a range of capabilities and experience, it makes sense when you want to go big to start big: to put your best foot forward, so to speak, to lead with your strengths — to take your best shot. We’re reminded of the words of World Heavyweight Boxing Champion Mike Tyson:

“Everybody has a plan until they get punched in the mouth”

— Mike Tyson

We need to go in, go in big, and make every digit count. Every digit, no matter how small, must do its part. We’re not looking for second-place here, people.

So, after studying the strengths of on our digits, let’s turn now to look to the number we need to make from them.

In a decimal representation of a number, each digit, moving leftward, is 10 times the value of its rightward neighbor, and that digit’s leftward superior will, in turn, increment-for-increment be 10 times more valuable than it. As the range of a given digit can only be 0 through 9, any leftward shift in position will yield a larger product for any positive value it might hold. Even the mysterious 0 holds more power, albeit elusively, as its mere presence in absence serves as a placeholder for still more left-shifted powers to come; zeros are never allowed to be leading so there will always be a position further on. The zero, in its nothingness, is stacking on another power of ten into the mix. The power is inherent in the position, and only augmented by its occupant.

So what can we conclude from our flowery analysis?

To construct the biggest number, we need to assign the largest digits to the largest positions. Which means to work from left-to-right, placing the largest digit, then the next-largest, then the next, with the smallest in the 1s place.

But what about that multiple-of-2 thing? Well what that means is that the number is even — that when we divide the number by two we get an integer. Divide, multiply — two sides of the same coin. And to see whether a number is even, we only need to look to the smallest digit, the 1s place. We know this intuitively, but if we want to know this mathematically we need only consider that the the value for the position one to the left of the 1s place is some digit quantity multiplied by 10, and that 10 is divisible by 2. Thus whatever partial sum at that position will always be divisible by 2. The same pattern can be generalized to all further leftward places, leaving only the 1s place to determine whether the number is odd or even.

So for the 1s place, we’ve previously determined that we want the smallest digit, and now we’ve added the criterium that we need an even digit too. So we will amend our method to place the smallest even digit in the 1s place, and build the rest of the number with the remaining sorted values as we did before. If we decrease the digit value from the 1s to the 10s place it doesn’t matter, as what we said earlier about the relative values of the positions still holds. Our intent is to maximize the value of each position to the total sum, assigning the largest digits we can to the most valuable positions. If a particular digit is needed elsewhere, in the 1s place, we need to do what we need to do. From each according to its ability. We’re a team.

There is, however, one loose end remaining: what do we do when there’s no digit divisible by 2? Well then in that case it’s impossible to make any number that satisfies the criteria. It simply cannot be done and no amount of arguing will change that fact. As a team we must also know when we have been beaten. We should probably say something before leaving.

PERL 5 SOLUTION

Creating the number is straightforward: we sort the list of digits, then, iterating upwards through the sorted array, we examine the values we find, looking for one that is divisible by two. The first one found is moved from its index to position [0], which will currently contain the smallest value, displacing that value up one position. The rest of the list will, however, retain the sorted order it previously had. The list is joined together and then reversed (or perhaps reversed and then joined, — you say “to-ma-to”, I say “de-licious“), before being printed out.

Voilà! Behold the largest number we can construct while still being divisible by two.

[colincrain@boris:~/Code/PWC]$  perl 115-2-list-one-perl-two.pl 1 8 7 7 3
77318

The code to construct it:

use warnings;
use strict;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';


my @arr = @ARGV;
scalar @arr == 0 and @arr = ( 1, 0, 2, 6);

say largest_two(\@arr);


sub largest_two ($arr, $i = 0) {
    @arr = sort {$a-$b} @$arr;
    for (@arr) {
        if ($arr[$i] % 2 == 0) {
            unshift @arr, splice @arr, $i, 1;
            last;
        }
        $i++;
    }

    return $i < @arr ?  join '', reverse @arr 
                     :  "none" ;
}

Raku Solution

In Raku we can produce the value in one powerful chain of functions, but our elegant condensation is a bit stymied by the case where no digit is divisible by 2. Perhaps the Raku way to deal with this would be to subtype Array with an Array that has one element divisible by two, something like

subset ArrayWith2 of Array where  {.any ~~ $_.Int %% 2} ;

and then use a multi sub to handle the cases, but that seems like a lot of work, so we’ll just put the clause in a ternary conditional and be done with it. The .unshift(), .join(), .flip() chain is still pretty, and again we get to throw an adverb at .first() to have it return the index key instead of the value, which is a sweet piece of functionality. Beautiful.

unit sub MAIN ( *@list ) ;

@list .= sort;
@list.any ~~ $_.Int %% 2 
    ?? say @list.unshift( @list.splice(@list.first(* %% 2, :k), 1) )
                .join
                .flip
    !! say "none";