Week 328 : 2025-06-30
Part 1
So for this week I had to put a little bit of work in rather than just doing a one liner. I probably could have done something with recursion inside regular expressions but it was really on Monday morning and the coffee hadn't fully kicked in.
The full code, including tests, can be found here. I'm going to skip the tests but I will highlight some stuff. Firstly the subsets, one of the nice things with string inputs is you can apply subsets to the and subsets can be nested. So we start by defining a subset of strings that is just lower case alphabetical characters or a questions mark.
subset AlphaLCAndQM of Str where * ~~ /^ <[a..z ?]>+ $/;
Catchy name I know. Then we can define a ValidInput. This is one where any pair of characters in the input either has a '?' in it or has two different values.
subset ValidInput of AlphaLCAndQM where {
$_.comb('').rotor(2=>-1).grep({ @_[0] !~~ '?' }).grep( { @_[0] ~~ @_[1] }).elems == 0;
}
The nice thing with this is as it's already a subset of AlphaLCAndQM
we get
the value checking too. Finally we'll define the ValidResult
subset. It's not
completely necessary but it does make out testing easier... I know I said I wouldn't show the testing
but I'll show why defining the result simplifies things.
subset ValidResult of ValidInput where * ~~ /^ <[a..z]>+ $/;
multi sub test-is-valid-input( ValidInput $str ) { True }
multi sub test-is-valid-input( $_ ) { False }
multi sub test-is-valid-result( ValidResult $str ) { True }
multi sub test-is-valid-result( $_ ) { False }
This is one of my favourite strategies, leveraging the power of Raku's pattern matching to give us some really clean code. With our input and output types defined we should probably look at solving the problem. My final solution went with a simple enough algorithm.
- For each character in the string :
- If it's not a
?
skip and continue. - Make an empty array.
- If we aren't looking at the first character put the character before in the array.
- If we aren't looking at the last character put the next character in the array.
- Get the Set Difference (see last week) of the list of all letters and our array.
- Pick a value from that at random and put it in at the current location.
- If it's not a
Of course to simplify things I use comb
to turn the string into an list that I then make into
and array and join
it after. With the final result looking like this.
sub replace-qms( ValidInput $str ) {
my @out = $str.comb().Array;
for 0..^@out.elems -> $idx {
next if @out[$idx] !~~ '?';
my @not = [];
if ( $idx > 0 ) { @not.push(@out[$idx-1]); }
if ( $idx != (@out.elems)-1 ) { @not.push(@out[$idx+1]); }
my $poss = ('a'..'z') (-) @not;
@out[$idx] = $poss.keys.roll(1)[0];
}
return @out.join('');
}
This means the final MAIN
block can be really nice and simple.
#|( Given a string of lower case letters with question marks in it
replace the question marks with letters so that we don't have
repeated characters.
)
multi sub MAIN(
ValidInput $str #= A string made up of lower case letters and question marks.
) { replace-qms($str).say }
Part 2
Ok. I'm going to admit I am still trying to get my head around how part two works. Specifically the intricacies of the Raku Regex system. But I'll give you a quick run down of my logic.
- Take your string that needs to be valid (so only has lower and upper case letters)
- Make a note of the strings current value.
- Look for the first pair of letters where you have the
lowercase then uppercase of the same letter
next to each other.
- If you find it remove it from the string.
- Look for the first pair of letters where you have the
uppercase then lowercase of the same letter
next to each other.
- If you find it remove it from the string.
- Compare the string to the noted value.
- If they are the same you are done, return the string.
- If they are different start the loop again with the new string.
So a nice little recursive loop. The inner part of which (parts 3 and 4 in the list) is
the process
function.
sub process(Str $str is copy) {
$str ~~ s/ (<[a..z]>) {}:my $u = $0.uc; ($u) //;
$str ~~ s/ (<[A..Z]>) {}:my $l = $0.lc; ($l) //;
return $str;
}
This, frankly, is the bit my brain is still getting it's self to understand. Mostly
the syntax. But if we look at the first line what we're doing is a string replace where
we match a lower case letter and put that in $0
then we fire a function
that assigns the uppercase value of $0
to $u
. Now that
this exists we can test that the next character in the string matches it. If it does
we replace the matched section (so the two characters) with a blank string.
Like I say, I understand what it's doing it's more the function syntax bit in the middle (that I shamelessly copied from the documentation) that I'm still a bit confused about. Still it works and this is the important part. With the process function we can finish our code. First define what's a valid input string.
subset ValidInput of Str where * ~~ /^ <[a..z A..Z]> + $/;
Make our good string creator, which implements the rest of the algorithm.
sub good-string(ValidInput $str is copy) {
my $new = '';
while ($new !~~ $str) {
$new = $str;
$str = process($str);
}
return $new;
}
Note how this and process copy the input string which allows us to modify the data. I prefer copying to making the input read writable, it's a bit less efficient but leads to less spooky action at a distance.
With our good string creator we now just populate the MAIN
function.
#|(Given a string of upper and lowercase letter
remove all pairs of upper and lower case letters next
to each other recursively)
multi sub MAIN(
ValidInput $str #= String made of upper and lowercase letters only
) {
good-string($str).say;
}
I do like a really small MAIN
block with a bit of documentation for the
wonderful Raku Command Line code.
So there's my thoughts on this weeks challenge, I learnt a bit. Well, learnt might be a stretch but I'm more aware of the possibilities I guess. So that's something. Anyway, roll on Monday and another challenge.