This is my response to The Weekly Challenge #296.
$chars.
Input: $chars = "abbc"
Output: "a2bc"
Input: $chars = "aaabccc"
Output: "3ab3c"
Input: $chars = "abcc"
Output: "ab2c"
#! /usr/bin/env raku
unit sub MAIN ($chars where $chars.chars > 0, # [1]
:v(:$verbose));
my $second = $chars ~~ /<[0..9]>/ # [2]
?? str-decompress($chars) # [2a]
!! str-compress($chars); # [2b]
say $second; # [3]
my $third = $second ~~ /<[0..9]>/ # [4]
?? str-decompress($second) # [4a]
!! str-compress($second); # [4b]
die "Rountripping is broken ($chars <=> $third)" # [5]
unless $chars eq $third;
say ":\n: Rountripping ok" if $verbose;
[1] At least one character in the input.
[2] If the input contains at least one (ascii) digit, decompress it [25a]. If not, compress [25b].
The \d escape sequence matches any character that
Unicode has decided is a digit, and there are a lot of them.
We do not want that here...
[3] Print the result.
[4] Roundtripping.
[5] Check that roundtripping worked out.
File: string-compression (compress)
sub str-compress ($string) # [11]
{
my @chars = $string.comb; # [12]
my $result = ""; # [13]
my $first = @chars.shift; # [14]
my $count = 1; # [15]
say ": Letter $first (the first)" if $verbose;
while (@chars.elems) # [16]
{
my $next = @chars.shift; # [17]
say ": Letter $next" if $verbose;
if $first eq $next # [18]
{
$count++; # [18a]
say ": - $first count $count" if $verbose;
}
else # [19]
{
$result ~= ( $count == 1 ?? $first !! "$count$first" ); # [19a]
$first = $next; # [19b]
$count = 1; # [19c]
}
}
$result ~= ( $count == 1 ?? $first !! "$count$first" ); # [20]
return $result; # [21]
}
[11] The procedure doing string compression.
[12] Split the input into an array of individual characters.
[13] The resulting (compressed) string will end up here.
[14] Get the first character.
[15] We have one of that character.
[16] As long as we have unfinished business.
[17] Get the next character.
[18] Are the two characters equal? If so, increase the counter [18a].
[19] If not, add the previous character to the result - compressed - [19a], and prepare for the next iteration with the new starting character [19b], which we have one of so far [19c].
[20] Add the last character to the result.
[21] Return the result
File: string-compression (decompress)
sub str-decompress ($string) # [31]
{
my $result = ""; # [32]
for $chars.comb -> $current # [33]
{
my $count = ""; # [34]
say ": Current letter $current" if $verbose;
while $current ~~ /^<[1..9]>$/ # [35]
{
$count ~= $current; # [36]
$current = @chars.shift || die "Missing letter"; # [37]
say ": - Real letter $current" if $verbose;
}
$count = 1 unless $count; # [38]
$result ~= ( $current x $count ); # [39]
}
return $result; # [40]
}
[31] The procedure doing string decompression.
[32] The resulting (decompressed) string will end up here.
[33] Iterate over the characters in the input string. (Note the difference compared to [16,17].)
[34] The current count (as an empty string so that we can add individual digits to it; e.g. "2" and "21" (as "2" and "1") as we iterate over each character.
[35] Do we have a digit? If so,
[36] • add the digit to the end of the count.
[37] • Get the next character, or die trying.
[38] Set the count to 1 if the string is empty, so that the next line will work.
[39] Print the required number of the current character,
using the string repetition operator x.
See docs.raku.org/routine/x for more information about x.
[40] Return the result.
Running it:
$ ./string-compression abbc
a2bc
$ ./string-compression aaabccc
3ab3c
$ ./string-compression abcc
ab2c
Looking good.
With verbose mode:
$ ./string-compression -v abbc
: Letter a (the first)
: Letter b
: Letter b
: - b count 2
: Letter c
a2bc
: Current letter a
: Current letter 2
: - Real letter b
: Current letter c
:
: Rountripping ok
$ ./string-compression -v aaabccc
: Letter a (the first)
: Letter a
: - a count 2
: Letter a
: - a count 3
: Letter b
: Letter c
: Letter c
: - c count 2
: Letter c
: - c count 3
3ab3c
: Current letter 3
: - Real letter a
: Current letter b
: Current letter 3
: - Real letter c
:
: Rountripping ok
$ ./string-compression -v abcc
: Letter a (the first)
: Letter b
: Letter c
: Letter c
: - c count 2
ab2c
: Current letter a
: Current letter b
: Current letter 2
: - Real letter c
:
: Rountripping ok
Entering the compressed values work out as well:
$ ./string-compression a2bc
abbc
$ ./string-compression 3ab3c
aaabccc
$ ./string-compression ab2c
abcc
Illegal input will fail:
$ ./string-compression abc1
Missing letter
in sub str-decompress at ./string-compression line 68
in sub MAIN at ./string-compression line 6
in block <unit> at ./string-compression line 1
It is easy to trip up roundtripping:
$ ./string-compression aaa2bbbb
aaabbbbb
Rountripping is broken (aaa2bbbb <=> 3a5b)
in sub MAIN at ./string-compression line 16
in block <unit> at ./string-compression line 1
Garbage in...
We are not restricted to alphabetic characters:
$ ./string-compression 🯱🯲🯲🯲🯲🯲🯲🯲
🯱7🯲
It is easy to restrict the input to alphabetic characters and digits only, as specified by the challenge:
unit sub MAIN ($chars where $chars ~~ /^<[A..Z a..z 0..9>]>+$/,
This regex requires at least one character, so we can skip the
.chars > 0 part in the original program (row [1]).
Let us fix the problem with a trailing digit as well:
File: string-compression-strict (changes only)
unit sub MAIN ($chars where $chars ~~ /^<[A..Z a..z 0..9>]>*<[A..Z a..z>]+$/,
@ints.
@ints where $ints[ì] is the
length of ith stick.
Input: @ints = (1, 2, 2, 2, 1)
Output: true
Top: $ints[1] = 2
Bottom: $ints[2] = 2
Left: $ints[3] = 2
Right: $ints[0] and $ints[4] = 2
Input: @ints = (2, 2, 2, 4)
Output: false
Input: @ints = (3, 4, 1, 4, 3, 1)
Output: true
#! /usr/bin/env raku
subset PosInt of Int where * > 0; # [1a]
unit sub MAIN (*@ints where @ints.elems >= 4 && all(@ints) ~~ PosInt, # [1]
:v(:$verbose));
unless @ints.sum %% 4 # [2]
{
say ": Unable to get 4 equally long edges" if $verbose;
say 'false'; # [2a]
exit; # [2b]
}
my $target = @ints.sum / 4; # [3]
say ": The edge sizes: $target" if $verbose;
if any(@ints) > $target # [4]
{
say ": One of the sticks is too long" if $verbose;
say 'false'; # [4a]
exit; # [4b]
}
my @square = (0,0,0,0); # [5]
my @labels = <Top Bottom Left Right>; # [6]
my $i = 0; # [7]
STICK: # [10b]
for @ints -> $stick # [8]
{
$i++; # [7a]
say ": Working on stick #$i with length $stick. Square: \
[{ @square.join(",") }]" if $verbose;
for 0 .. 3 -> $index # [8]
{
say ": Checking @labels[$index]" if $verbose;
next unless @square[$index] + $stick <= $target; # [9]
@square[$index] += $stick; # [10]
say ": Added stick #$i to @labels[$index] -> length: @square[$index]"
if $verbose;
next STICK; # [10a]
}
say ": Unable to use this stick" if $verbose;
say 'false'; # [11]
exit; # [11a]
}
say ": Square: [{ @square.join(",") }]" if $verbose;
say [==] @square ?? 'true' !! 'false'; # [12]
[1] The sticks (minimum 4 of them) must have a positive length, and we ensure that with the custom «PosInt» type.
See docs.raku.org/routine/subset for more information about subset.
[2] The 4 edges must have the same length, so we can fail right
away if the sum of lengths is not divisible by (%%) 4.
See docs.raku.org/routine/%% for more information about %%.
[3] Get the target length for the four edges.
[4] Fail if any of the edges is too long .
[5] An array holding the length of the four edges, as we distribute the sticks. Initially we have zero lengths.
[6] The names of the edges, as given by the challenge, and used by verbose mode.
[7] The stick number (starting at 1), used by verbose mode.
[8] Iterate over the (zero based) indices for the four edges in the array (in [5]).
[9] Skip the current edge if we cannot add the stick to it (as in: the edge would end up beeing too long).
[10] Add the stick to the edge, and go on to the next stick (i.e skip [11,11a]).
[11] If we get here, it means that we were unable to add the stick to an (any) edge. Report the failure, and exit.
[12] Use the Reduction Metaoperator
[] in combination with the equality operator == to check that
the four edges have the same length. Report the result.
See
docs.raku.org/language/operators#Reduction_metaoperators for more
information about the Reduction Metaoperator [].
Running it:
$ ./matchstick-square 1 2 2 2 1
True
$ ./matchstick-square 2 2 2 4
false
$ ./matchstick-square 3 4 1 4 3 1
True
Looking good.
With verbose mode:
$ ./matchstick-square -v 1 2 2 2 1
: The edge sizes: 2
: Working on stick #1 with length 1. Square: [0,0,0,0]
: Checking Top
: Added stick #1 to Top -> length: 1
: Working on stick #2 with length 2. Square: [1,0,0,0]
: Checking Top
: Checking Bottom
: Added stick #2 to Bottom -> length: 2
: Working on stick #3 with length 2. Square: [1,2,0,0]
: Checking Top
: Checking Bottom
: Checking Left
: Added stick #3 to Left -> length: 2
: Working on stick #4 with length 2. Square: [1,2,2,0]
: Checking Top
: Checking Bottom
: Checking Left
: Checking Right
: Added stick #4 to Right -> length: 2
: Working on stick #5 with length 1. Square: [1,2,2,2]
: Checking Top
: Added stick #5 to Top -> length: 2
: Square: [2,2,2,2]
True
$ ./matchstick-square -v 2 2 2 4
: Unable to get 4 equally long edges
false
$ ./matchstick-square -v 3 4 1 4 3 1
: The edge sizes: 4
: Working on stick #1 with length 3. Square: [0,0,0,0]
: Checking Top
: Added stick #1 to Top -> length: 3
: Working on stick #2 with length 4. Square: [3,0,0,0]
: Checking Top
: Checking Bottom
: Added stick #2 to Bottom -> length: 4
: Working on stick #3 with length 1. Square: [3,4,0,0]
: Checking Top
: Added stick #3 to Top -> length: 4
: Working on stick #4 with length 4. Square: [4,4,0,0]
: Checking Top
: Checking Bottom
: Checking Left
: Added stick #4 to Left -> length: 4
: Working on stick #5 with length 3. Square: [4,4,4,0]
: Checking Top
: Checking Bottom
: Checking Left
: Checking Right
: Added stick #5 to Right -> length: 3
: Working on stick #6 with length 1. Square: [4,4,4,3]
: Checking Top
: Checking Bottom
: Checking Left
: Checking Right
: Added stick #6 to Right -> length: 4
: Square: [4,4,4,4]
True
Testing the special cases:
$ ./matchstick-square -v 1 1 1 99
: Unable to get 4 equally long edges
false
$ ./matchstick-square -v 1 2 2 3
: The edge sizes: 2
: One of the sticks is too long
false
Are the two special cases enough to decide if we are able to make a sqare?
Short answer: No.
The following example, that satisfies both special cases, does not work out:
$ ./matchstick-square -v 8 8 5 4 6 1
: The edge sizes: 8
: Working on stick #1 with length 8. Square: [0,0,0,0]
: Checking Top
: Added stick #1 to Top -> length: 8
: Working on stick #2 with length 8. Square: [8,0,0,0]
: Checking Top
: Checking Bottom
: Added stick #2 to Bottom -> length: 8
: Working on stick #3 with length 5. Square: [8,8,0,0]
: Checking Top
: Checking Bottom
: Checking Left
: Added stick #3 to Left -> length: 5
: Working on stick #4 with length 4. Square: [8,8,5,0]
: Checking Top
: Checking Bottom
: Checking Left
: Checking Right
: Added stick #4 to Right -> length: 4
: Working on stick #5 with length 6. Square: [8,8,5,4]
: Checking Top
: Checking Bottom
: Checking Left
: Checking Right
: Unable to use this stick
false
And that's it.