RabbitFarm

2024-11-25

String Together a Square

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1: String Compression

You are given a string of alphabetic characters, $chars. Write a script to compress the string with run-length encoding.

A compressed unit can be either a single character or a count followed by a character.

BONUS: Write a decompression function.

After working so much with recursion for the previous challenge, TWC 295, this time around we’ll use a simple loop mechanism available in Perl: a redo block.

The main loop for iterating over the characters one by one.

⟨loop over letters 1 ⟩≡


my $previous = q//;
{
my $c = shift @{$s};
$count++ if $c eq $previous;
if($c ne $previous){
⟨concatenate partial encoding 2 ⟩
$count = 1;
}
$previous = $c;
redo if 0 < @{$s};
}
⟨concatenate partial encoding 2 ⟩
◇

Fragment referenced in 3.

Uses: $count 3, $s 3, 5.

⟨concatenate partial encoding 2 ⟩≡


$encoding .= "$count$previous" if $count > 1;
$encoding .= $previous if $count == 1;
◇

Fragment referenced in 1.

Uses: $count 3, $encoding 3.

Here’s a subroutine which co-ordinates encoding: splits the string, invokes the loop, and returns the compressed format.

⟨string compression: co-ordinates encoding 3 ⟩≡


sub encoding{
my($s) = @_;
my $count = 0;
my $encoding = q//;
$s = [split //, $s];
⟨loop over letters 1 ⟩
return $encoding;
}
◇

Fragment referenced in 6.

Defines: $count 1, 2, $encoding 2, $s 1, 4, 5.

The BONUS seems to be fairly doable. Given an encoded string we can expand it back to the original by a similar process as the encoding. In fact, let’s use the same sort of loop.

⟨loop over encoded string 4 ⟩≡


my $previous = q//;
{
my $c = shift @{$s};
if($c =~ m/\d/){
my $d = $c;
$c = shift @{$s};
$decoded .= $c x $d;
}
else{
$decoded .= $c;
}
redo if 0 < @{$s};
}
◇

Fragment referenced in 5.

Uses: $decoded 5, $s 3, 5.

As before we’ll define a subroutine which co-ordinates decoding.

⟨decoding 5 ⟩≡


sub decoding{
my($s) = @_;
my $decoded = q//;
$s = [split //, $s];
⟨loop over encoded string 4 ⟩
return $decoded;
}
◇

Fragment referenced in 6.

Defines: $decoded 4, $s 1, 3, 4.

Putting it all together...

"ch-1.pl" 6≡


⟨preamble 7 ⟩
⟨string compression: co-ordinates encoding 3 ⟩
⟨decoding 5 ⟩
⟨main 8 ⟩
◇

⟨preamble 7 ⟩≡


use v5.40;
◇

Fragment referenced in 6, 12.

The rest of the code just runs some simple tests.

⟨main 8 ⟩≡


MAIN:{
say encoding q/abbc/;
say encoding q/aaabccc/;
say encoding q/abcc/;

say q//;

say decoding encoding q/abbc/;
say decoding encoding q/aaabccc/;
say decoding encoding q/abcc/;
}
◇

Fragment referenced in 6.

Sample Run
$ perl perl/ch-1.pl 
a2bc 
3ab3c 
ab2c 
 
abbc 
aaabccc 
abcc

Part 2: Matchstick Square

You are given an array of integers, @ints. Write a script to find if it is possible to make one square using the sticks as in the given array @ints where $ints[$i] is the length of ith stick.

First let’s notice that the lengths must all sum to a number evenly divisible by four, so that’ll be an initial filter on the list. If that first test passes we divide the sum by four (to get the side length) and determine if we can get four subsets which all sum to that side length.

⟨test if evenly divisible by four 9 ⟩≡


my $length_sum = unpack(q/%32I*/, pack(q/I*/, @{$matchsticks}));
return false if 0 != $length_sum % 4;
my $side_length = $length_sum / 4;
◇

Fragment referenced in 11.

Defines: $side_length 10.

Uses: $matchsticks 11.

If we have a sum of lengths evenly divisible by four we’ll then check if if we have four subsets which sum to the computed side length. To do this we’ll compute the powerset (all subsets) of the list and check the sums.

⟨check subset sums 10 ⟩≡


my $counter = 0;
my $ps_iterator = powerset_lazy(@{$matchsticks});
while(my $set = $ps_iterator->()){
my $set_sum = unpack(q/%32I*/, pack(q/I*/, @{$set}));
$counter++ if $set_sum == $side_length;
return true if $counter == 4;
}
return false;
◇

Fragment referenced in 11.

Uses: $matchsticks 11, $side_length 9.

⟨is_square: co-ordinates all the checks 11 ⟩≡


sub is_square{
my $matchsticks = [@_];
⟨test if evenly divisible by four 9 ⟩
⟨check subset sums 10 ⟩
}
◇

Fragment referenced in 12.

Defines: $matchsticks 9, 10.

The rest of the code drives some tests.

"ch-2.pl" 12≡


⟨preamble 7 ⟩
use boolean;
use List::PowerSet q/powerset_lazy/;
⟨is_square: co-ordinates all the checks 11 ⟩
⟨main 13 ⟩
◇

⟨main 13 ⟩≡


MAIN:{
say boolean is_square 1, 2, 2, 2, 1;
say boolean is_square 2, 2, 2, 4;
say boolean is_square 2, 2, 2, 2, 4;
say boolean is_square 3, 4, 1, 4, 3, 1;
}
◇

Fragment referenced in 12.

Sample Run
$ perl perl/ch-2.pl 
1 
0 
0 
1

References

The Weekly Challenge 295
Generated Code

posted at: 00:31 by: Adam Russell | path: /perl | permanent link to this entry