Perl Weekly Challenge 349.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 349.
Task 1: Power String
Submitted by: Mohammad Sajid Anwar
You are given a string.
Write a script to return the power of the given string.
The power of the string is the maximum length of a non-empty
substring that contains only one unique character.
Example 1
Input: $str = "textbook"
Output: 2
Breakdown: "t", "e", "x", "b", "oo", "k"
The longest substring with one unique character is "oo".
Example 2
Input: $str = "aaaaa"
Output: 5
Example 3
Input: $str = "hoorayyy"
Output: 3
Breakdown: "h", "oo", "r", "a", "yyy"
The longest substring with one unique character is "yyy".
Example 4
Input: $str = "x"
Output: 1
Example 5
Input: $str = "aabcccddeeffffghijjk"
Output: 4
Breakdown: "aa", "b", "ccc", "dd", "ee", "ffff", "g", "h",
"i", "jj", "k"
The longest substring with one unique character is "ffff".
I repeatedly remove the first character and its repetitions from the
string, and add the length of the corresponding substring to an array
of lengths. We are looking for the max
element of that array. The code takes a one-liner.
Examples:
perl -MList::Util=max -E '
for(@ARGV){$i=$_;my @s; push @s,length $1 while s/^((.)\2*)//;say "$i -> ", max @s}
' textbook aaaaa hoorayyy x aabcccddeeffffghijjk
Results:
textbook -> 2
aaaaa -> 5
hoorayyy -> 3
x -> 1
aabcccddeeffffghijjk -> 4
The full code is:
1 # Perl weekly challenge 349
2 # Task 1: Power String
3 #
4 # See https://wlmb.github.io/2025/11/24/PWC349/#task-1-power-string
5 use v5.36;
6 use List::Util qw(max);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S0 S1...
9 to find the power of the strings S0, S1...,
10 i.e., the longest substring of repeated characters.
11 FIN
12 for(@ARGV){
13 my $in = $_;
14 my $length = 0;
15 while(s/^((.)\2*)//){
16 my $l = length $1;
17 $length = $l if $l > $length;
18 }
19 say "$in -> $length";
20 }
Example:
./ch-1.pl textbook aaaaa hoorayyy x aabcccddeeffffghijjk
Results:
textbook -> 2
aaaaa -> 5
hoorayyy -> 3
x -> 1
aabcccddeeffffghijjk -> 4
Task 2: Meeting Point
Submitted by: Mohammad Sajid Anwar
You are given instruction string made up of U (up), D (down),
L (left) and R (right).
Write a script to return true if following the instruction,
you meet the starting point (0,0).
Example 1
Input: $path = "ULD"
Output: false
(-1,1) <- (0,1)
| ^
v |
(-1,0) (0,0)
Example 2
Input: $path = "ULDR"
Output: true
(-1,1) <- (0,1)
| ^
v |
(-1,0) -> (0,0)
Example 3
Input: $path = "UUURRRDDD"
Output: false
(0,3) -> (1,3) -> (2,3) -> (3,3)
^ |
| v
(0,2) (3,2)
^ |
| v
(0,1) (3,1)
^ |
| v
(0,0) (3,0)
Example 4
Input: $path = "UURRRDDLLL"
Output: true
(0,2) -> (1,2) -> (2,2) -> (3,2)
^ |
| v
(0,1) (3,1)
^ |
| v
(0,0) <- (1,0) <- (1,1) <- (3,0)
Example 5
Input: $path = "RRUULLDDRRUU"
Output: true
(0,2) <- (1,2) <- (2,2)
| ^
v |
(0,1) (2,1)
| ^
v |
(0,0) -> (1,0) -> (2,1)
A simple (wrong) solution is to count the appearance of the letters ULDR. I f there are as many U’s as D’s and as many L’s as R’s, then we end at the starting position. This yields a half-liner:
perl -E '
for(@ARGV){my%c;$c{$_}++ for split"";say"$_ -> ",$c{U}==$c{D}&&$c{L}==$c{R}?"T":"F"}
' ULD ULDR UUURRRDDD UURRRDDLLL RRUULLDDRRUU
Results:
ULD -> F
ULDR -> T
UUURRRDDD -> F
UURRRDDLLL -> T
RRUULLDDRRUU -> F
The last result shows that I had misunderstood the statement of the problem. The result should be T even if the last position is not (0,0), as long as the trajectory returns to (0,0) at any time after the first move. The fix is simple: test the intermediate positions. The result still fits a one liner.
perl -E '
for(@ARGV){my%c;$r="F";for(split ""){$c{$_}++;$r="T",last if$c{U}==$c{D}&&$c{L}==$c{R}}say"$_ -> $r"}
' ULD ULDR UUURRRDDD UURRRDDLLL RRUULLDDRRUU
Results:
ULD -> F
ULDR -> T
UUURRRDDD -> F
UURRRDDLLL -> T
RRUULLDDRRUU -> T
For the full code I use the Perl Data Language to update and check the current position. If I ever return to [0,0] the result is True:
1 # Perl weekly challenge 349
2 # Task 2: Meeting Point
3 #
4 # See https://wlmb.github.io/2025/11/24/PWC349/#task-2-meeting-point
5 use v5.36;
6 use feature qw(try);
7 use List::Util qw(zip);
8 use PDL;
9 die <<~"FIN" unless @ARGV;
10 Usage: $0 P0 P1...
11 to find if the path Pn returns to the starting points.
12 Each path is a string with the letters U, D, L and R, indicating
13 a step up, down, left and right.
14 FIN
15 my %movements=map{$_->[0], pdl $_->[1]} zip [qw(U D R L)], [[0,1], [0,-1], [1,0], [-1,0]];
16 for(@ARGV){
17 try {
18 die "The only allowed letters are U, D, L, and R: $_" unless /^[UDLR]*$/;
19 my $result = "False";
20 my $current = pdl[0,0];
21 for(split ""){
22 $current += $movements{$_};
23 $result = "True", last unless any($current);
24 }
25 say "$_ -> $result";
26 }
27 catch($e){warn $e;}
28 }
Example:
./ch-2.pl ULD ULDR UUURRRDDD UURRRDDLLL RRUULLDDRRUU
Results:
ULD -> False
ULDR -> True
UUURRRDDD -> False
UURRRDDLLL -> True
RRUULLDDRRUU -> True
/;