Perl Weekly Challenge 318.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 318.
Task 1: Group Position
Submitted by: Mohammad Sajid Anwar
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.
Example 1
Input: $str = "abccccd"
Output: "cccc"
Example 2
Input: $str = "aaabcddddeefff"
Output: "aaa", "dddd", "fff"
Example 3
Input: $str = "abcdd"
Output: ""
I use a regular expression to repeatedly capture and return a character followed by two or more repetitions of the same. I grep the resulting list to get rid of the single characters and keep the group of repetitions. This fits a half-liner.
Examples:
perl -E '
say "$_ -> ", join ", ", grep {$c++%2==0} /((.)\2{2,})/g for @ARGV;
' abccccd aaabcddddeefff abcdd
Results:
abccccd -> cccc
aaabcddddeefff -> aaa, dddd, fff
abcdd ->
The full code is almost identical:
1 # Perl weekly challenge 318
2 # Task 1: Group Position
3 #
4 # See https://wlmb.github.io/2025/04/21/PWC318/#task-1-group-position
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 S1 S2...
8 to find groups of three or more repeated characters within
9 the strings S1, S2...
10 FIN
11 my $counter=0;
12 say "$_ -> ",
13 join ", ",
14 grep {$counter++%2==0} # keep even numbered elements
15 /((.)\2{2,})/g # find 3 or more repetitions of a character
16 # return group and character
17 for @ARGV;
Examples:
./ch-1.pl abccccd aaabcddddeefff abcdd
Results:
abccccd -> cccc
aaabcddddeefff -> aaa, dddd, fff
abcdd ->
Task 2: Reverse Equals
Submitted by: Roger Bell_West
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.
Example 1
Input: @source = (3, 2, 1, 4)
@target = (1, 2, 3, 4)
Output: true
Reverse elements: 0-2
Example 2
Input: @source = (1, 3, 4)
@target = (4, 1, 3)
Output: false
Example 3
Input: @source = (2)
@target = (2)
Output: true
A simple solution would be to eat all equal characters from the front and the back of the strings and then check if the remaining middle subarrays are the reverse of each other. This fits a two-liner
Example 1:
perl -E '
($p,$q)=map{[split " "]}@a=@ARGV;f();($p,$q)=map{[reverse@$_]}($p,$q);f();$p=[reverse @$p];f();say
"$a[0];$a[1]->",@$p==@$q==0?"T":"F";sub f(){while(@$p&&$p->[0]==$q->[0]){shift$_->@* for($p,$q)}}
' "3 2 1 4" "1 2 3 4"
Results:
3 2 1 4;1 2 3 4->T
The function f eats equal elements from the front of the arrays $p
and $q. Reversing both arrays we can use it to delete from the
back. Reversing one, we can delete from the front of one array and
from the back of another. After eating all equal terms from the front
of both arrays, from the back of the remaining arrays and from the
back of one and the front of the other array the result should be
empty arrays if reversing one subarray of one array produces the
other.
Example 2
perl -E '
($p,$q)=map{[split " "]}@a=@ARGV;f();($p,$q)=map{[reverse@$_]}($p,$q);f();$p=[reverse @$p];f();say
"$a[0];$a[1]->",@$p==@$q==0?"T":"F";sub f(){while(@$p&&$p->[0]==$q->[0]){shift$_->@* for($p,$q)}}
' "1 3 4" "4 1 3"
Results:
1 3 4;4 1 3->F
Example 3
perl -E '
($p,$q)=map{[split " "]}@a=@ARGV;f();($p,$q)=map{[reverse@$_]}($p,$q);f();$p=[reverse @$p];f();say
"$a[0];$a[1]->",@$p==@$q==0?"T":"F";sub f(){while(@$p&&$p->[0]==$q->[0]){shift$_->@* for($p,$q)}}
' "2" "2"
Results:
2;2->T
The corresponding full code is:
1 # Perl weekly challenge 318
2 # Task 2: Reverse Equals
3 #
4 # See https://wlmb.github.io/2025/04/21/PWC318/#task-2-reverse-equals
5 use v5.36;
6 die <<~"FIN" unless @ARGV==2;
7 Usage: $0 A1 A2
8 to check if the arrays of numbers become equal after reversing one subarray.
9 Each array is a space separated string.
10 FIN
11 my ($array1, $array2)=map {[split " "]} @ARGV;
12 my ($sorted1, $sorted2)=map {[sort {$a <=> $b} @$_]} ($array1, $array2);
13 eat_equal($sorted1, $sorted2);
14 die "Arrays should have the same elements" unless @$sorted1==@$sorted2==0;
15 eat_equal($array1, $array2);
16 my ($reverse1, $reverse2)=map {[reverse @$_]} ($array1, $array2);
17 eat_equal($reverse1, $reverse2);
18 my $revreverse1=[reverse @$reverse1];
19 eat_equal($revreverse1, $reverse2);
20 my $result=@$revreverse1==@$reverse2==0?"True":"False";
21 say "$ARGV[0]; $ARGV[1] -> $result";
22
23 sub eat_equal($p, $q){ # eat equal numbers from the front of arrays $p and $q
24 while(@$p && $p->[0]==$q->[0]){
25 shift $_->@* for ($p,$q);
26 }
27 }
Examples:
./ch-2.pl "3 2 1 4" "1 2 3 4"
./ch-2.pl "1 3 4" "4 1 3"
./ch-2.pl "2" "2"
Results:
3 2 1 4; 1 2 3 4 -> True
1 3 4; 4 1 3 -> False
2; 2 -> True
Notice I didn’t consider possible ambiguous situations such as multiple ways of assigning the front, middle and back subarrays.
/;