Perl Weekly Challenge: Week 115
Challenge 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.
Example
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.
my (%first, %last);
What we have to do here is to make a set of first characters of the input strings and a set of the last characters. If the two sets are equivalent (i.e. they contain the same elements) a crcle can be formed otherwise not. Now I thought this would be easy in Raku. After all it has a native Set class and operators so a solution could look something like this:
my $first = SetHash.new;
my $last = SetHash.new;
for @args -> $arg {
$first.set$arg.substr(0, 1));
$last.set($arg.substr(*-1, 1));
}
say ($first ≡ $last) ?? 1 !! 0;
We have to use the SetHash datatype because Set itself is immutable. ≡ is the unicode form of the Set Equivalancy
operator. It can also be written as (==). The trouble is that none of this works. I kept getting strange errors such as
"two terms in a row" etc. even though I had checked and doubled that I had got the syntax correct. I think the problem is
my version of Raku (I'm still on 2019.11 apparently) is too old and this stuff wasn't implemented. I didn't have time to
upgrade to a newer Raku so instead I rewrote it using ordinary hashes.
sub MAIN(*@args) {
my (%first, %last);
for @args -> $arg {
%first{$arg.substr(0, 1)} = True;
%last{$arg.substr(*-1, 1)} = True;
}
If both hashes have the same keys, they are equivalent.
for %first.keys -> $key {
unless %last{$key}:exists {
say 0;
exit;
}
}
say 1;
}
For perl, I had no alternative except to use hashes.
for my $arg (@ARGV) {
$first{substr($arg, 0, 1)} = 1;
$last{substr($arg, -1, 1)} = 1;
}
for my $arg (@ARGV) {
$first{substr($arg, 0, 1)} = 1;
$last{substr($arg, -1, 1)} = 1;
}
for my $key (keys %first) {
unless (exists $last{$key}) {
say 0;
exit;
}
}
say 1;
Challenge 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.
Example
Input: @N = (1, 0, 2, 6)
Output: 6210
Input: @N = (1, 4, 2, 8)
Output: 8412
Input: @N = (4, 1, 7, 6)
Output: 7614
Perl first this time.
After taking input digits from the command lin4, we sort them largest to smallest.
my @N = sort { $b <=> $a } @ARGV;
If the last digit is even we are done but otherwise it has to be swapped with the smallest even number. What if all the digits are odd? The spec didn't say so I chose to just subtract 1 from the last digit making the whole number even again.
if ($N[-1] % 2 == 1) {
my $lasteven = -1;
while (defined $N[$lasteven] && $N[$lasteven] % 2 == 1) {
$lasteven--;
}
if (defined $N[$lasteven]) {
my $temp = $N[$lasteven];
splice @N, $lasteven, 1;
push @N, $temp;
} else {
$N[-1]--;
}
}
say join q{}, @N;
And this is Raku.
my @N = @args.sort({$^b <=> $^a});
One problem I ran into is that in Raku, negative subscripts need to be prefixed by *. I couldn't figure
out how to store that in a variable I could decrement so instead I made $lasteven positive 1 and counted up,
I negated this value whenever I needed to use it thus providing the appropriate element.
if @N[*-1] % 2 == 1 {
my $lasteven = 1;
while @N[*-$lasteven] !~~ Nil && @N[*-$lasteven] % 2 == 1 {
$lasteven++;
}
if @N[*-$lasteven] !~~ Nil {
my $temp = @N[*-$lasteven];
@N.splice(*-$lasteven, 1);
@N.push($temp);
} else {
@N[*-1]--;
}
}
@N.join.say;