RabbitFarm

2025-04-27

Group Position Reversals

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

Part 1: Group Position

You are given a string of lowercase letters. Write a script to find the position of all groups in the given string. Three or more consecutive letters form a group. Return “” if none found.

Here’s our one subroutine, this problem requires very little code.

⟨groupings 1 ⟩≡


sub groupings{
my($s) = @_;
my @groups;
my @group;
my($current, $previous);
my @letters = split //, $s;
$previous = shift @letters;
@group = ($previous);
do {
$current = $_;
if($previous eq $current){
push @group, $current;
}
if($previous ne $current){
if(@group >= 3){
push @groups, [@group];
}
@group = ($current);
}
$previous = $current;
} for @letters;
if(@group >= 3){
push @groups, [@group];
}
my @r = map {q/"/␣.␣join(q//,␣@{$_}) . q/"/␣}␣@groups;
return join(q/, /, @r) || q/""/;
}
◇

Fragment referenced in 2.

Putting it all together...

"ch-1.pl" 2≡


⟨preamble 3 ⟩
⟨groupings 1 ⟩
⟨main 4 ⟩
◇

⟨preamble 3 ⟩≡


use v5.40;
◇

Fragment referenced in 2, 7.

The rest of the code just runs some basic tests.

⟨main 4 ⟩≡


MAIN:{
say groupings q/abccccd/;
say groupings q/aaabcddddeefff/;
say groupings q/abcdd/;
}
◇

Fragment referenced in 2.

Sample Run
$ perl perl/ch-1.pl 
"cccc" 
"aaa", "dddd", "fff" 
""

Part 2: Reverse Equals

You are given two arrays of integers, each containing the same elements as the other. Write a script to return true if one array can be made to equal the other by reversing exactly one contiguous subarray.

Here’s the process we’re going to follow.

  1. scan both arrays and check where and how often they differ
  2. if they differ in zero places return true!
  3. if they differ in one or more places check to see if the reversal makes the two arrays equal

⟨scan both arrays 5 ⟩≡


my $indices_different = [];
for my $i (0 .. @{$u} - 1){
push @{$indices_different}, $i unless $u->[$i] eq $v->[$i];
}
◇

Fragment referenced in 7.

Defines: $indices_different 6.

Uses: $u 7, $v 7.

Now let’s check and see how many differences were found.

⟨review the differences found 6 ⟩≡


return 1 if @{$indices_different} == 0;
$indices_different = [sort {$a <=> $b} @{$indices_different}];
my $last_i = $indices_different->[@{$indices_different} - 1];
my $length = 1 + $last_i - $indices_different->[0];
my @u_ = reverse @{$u}[$indices_different->[0] .. $last_i];
my @v_ = reverse @{$v}[$indices_different->[0] .. $last_i];
splice @{$u}, $indices_different->[0], $length, @u_;
splice @{$v}, $indices_different->[0], $length, @v_;
return 1 if join(q/,/, @{$u}) eq join(q/,/, @{$t});
return 1 if join(q/,/, @{$v}) eq join(q/,/, @{$s});
return 0;
◇

Fragment referenced in 7.

Uses: $indices_different 5, $s 7, $t 7, $u 7, $v 7.

The rest of the code combines the previous steps and drives some tests.

"ch-2.pl" 7≡


⟨preamble 3 ⟩
sub reverse_equals{
my($u, $v) = @_;
my($s, $t) = ([@{$u}], [@{$v}]);
⟨scan both arrays 5 ⟩
⟨review the differences found 6 ⟩
}
⟨main 8 ⟩
◇

Defines: $s 6, $t 6, $u 5, 6, $v 5, 6.

⟨main 8 ⟩≡


MAIN:{
say reverse_equals [3, 2, 1, 4], [1, 2, 3, 4];
say reverse_equals [1, 3, 4], [4, 1, 3];
say reverse_equals [2], [2];
}
◇

Fragment referenced in 7.

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

References

The Weekly Challenge 318
Generated Code

posted at: 19:21 by: Adam Russell | path: /perl | permanent link to this entry