Perl Weekly Challenge 394.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 394.
Task 1: Alternate Case
Submitted by: Mohammad Sajid Anwar
You are given a string containing an equal number of uppercase and
lowercase English letters.
Write a script to the minimum number of adjacent character swaps
needed to turn the given string into an alternate case string.
Example 1
Input: $str = "aAbB"
Output: 0
Example 2
Input: $str = "AAbb"
Output: 1
Swap 1: "AbAb"
Example 3
Input: $str = "AAAbbb"
Output: 3
Swap 1: "AAbAbb"
Swap 2: "AbAAbb"
Swap 3: "AbAbAb"
Example 4
Input: $str = "aABb"
Output: 1
Swap 1: "aAbB"
Example 5
Input: $str = "bBBAaa"
Output: 2
Swap 1: "BbBAaa"
Swap 2: "BbBaAa"
I translate upper/lower case letters to 0/1. Then, if there are two consecutive 0’s/1’s followed or preceded by a 1/0, I do a transposition and increase a counter. When it is no longer possible. I output the count. The result takes a 1.5-liner.
perl -E '
for(@ARGV){$i=$_;s/[A-Z]/0/g;s/[a-z]/1/g;$c=0;++$c while s/011|110/101/
||s/100|001/010/;say "$i -> $c"}
' aAbB AAbb AAAbbb aABb bBBAaa
Results:
aAbB->0
AAbb->1
AAAbbb->3
aABb->1
bBBAaa->2
Note. I haven’t attempted to prove this strategy yields the minimum number of swaps, but it did work on all the examples.
The full code is:
1 # Perl weekly challenge 394
2 # Task 1: Alternate Case
3 #
4 # See https://wlmb.github.io/2026/10/05/PWC394/#task-1-alternate-case
5 use v5.36;
6 use utf8;
7 use feature qw(try);
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 S0 S1...
10 to count the number of adjacent transpositions required to
11 turn the string Sn into alternate case. Sn should contain the same number
12 of upper and lower case letters.
13 FIN
14 for(@ARGV){
15 try {
16 my $in=$_;
17 die "Expected even sized string: $in" unless length($_) % 2 == 0;
18 die "Extraneous character found: $in" unless /^[A-Za-z]*$/;
19 s/[A-Z]/0/g;
20 s/[a-z]/1/g;
21 my $sum=(my $test=$_)=~tr/1/x/;
22 die "Unbalanced string: $in" unless $sum*2 == length;
23 my $count=0;
24 ++$count while
25 s/011|110/101/
26 || s/100|001/010/;
27 say "$in -> $count";
28 }
29 catch($e){
30 warn $e;
31 }
32 }
Examples:
./ch-1.pl aAbB AAbb AAAbbb aABb bBBAaa
Results:
aAbB -> 0
AAbb -> 1
AAAbbb -> 3
aABb -> 1
bBBAaa -> 2
Other examples:
./ch-1.pl 2>&1 aAa a0 aaBb
Results:
Expected even sized string: aAa at ./ch-1.pl line 18.
Extraneous character found: a0 at ./ch-1.pl line 19.
Unbalanced string: aaBb at ./ch-1.pl line 23.
Task 2: Alternating Vowels Consonants
Submitted by: Mohammad Sajid Anwar
You are given three strings containing English alphabetic characters.
Find all the longest contiguous substrings common to all three strings
that strictly alternate between vowels and consonants.
Example 1
Input: @str = ("relocate", "delocate", "allocate")
Output: ("locate")
Example 2
Input: @str = ("apple", "banana", "cherry")
Output: ()
Example 3
Input: @str = ("navigate", "cavity", "gravity")
Output: ("avi")
Example 4
Input: @str = ("pedalgia", "pedalboard", "pedantic")
Output: ("peda")
Example 5
Input: @strings = ("schoolmaster", "schoolhouse", "schooling")
Output: ("ho", "ol")
I write a function that finds all word fragments that are common between a given word and an array of words, filtering out those that don’t alternate between vocal and consonant. Then I find the longest fragment and I keep and print the largest fragments. The code fits a 3.5-liner.
Examples:
perl -MList::Util=max -E '
$v="aeiou";for(@ARGV){my($x,$y,$z)=split" ";$c=f($x,f($y,[$z]));$m=max map{length}@$c;
say"$_ -> ",join" ",grep{$m==length}@$c;}sub f($w,$r){my @s;for my$s(0..length($w)-1){
for my$l(1..length($w)-$s){my $f=substr $w,$s,$l;next unless $f=~/^[^$v]?([$v][^$v])*[$v]?$/;
push @s,$f if grep{m/$f/}@$r}}return [@s];}
' "relocate delocate allocate" "apple banana cherry" "navigate cavity gravity" \
"pedalgia pedalboard pedantic" "schoolmaster schoolhouse schooling"
Results:
relocate delocate allocate -> locate
apple banana cherry ->
navigate cavity gravity -> avi
pedalgia pedalboard pedantic -> peda
schoolmaster schoolhouse schooling -> ho ol
The full code is:
1 # Perl weekly challenge 394
2 # Task 2: Alternating Vowels Consonants
3 #
4 # See https://wlmb.github.io/2026/10/05/PWC394/#task-2-alternating-vowels-consonants
5 use v5.36;
6 use List::Util qw(max);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S0 S1...
9 to find the longest common substrings with alternating
10 vowels and consonants of the three space separated words
11 in string Sn
12 FIN
13 my $vowels="aeiou";
14 for(@ARGV){
15 my($x,$y,$z) = split " ";
16 my $frags = fragments($x, fragments($y, [$z]));
17 my $max = max map {length} @$frags;
18 say "$_ -> ", join " ", grep {$max == length} @$frags;
19 }
20 sub fragments($word, $rest){
21 my @frags;
22 for my $start(0..length($word)-1){
23 for my $length(1..length($word) - $start){
24 my $frag = substr $word, $start, $length;
25 next unless $frag=~/^[^$vowels]?([$vowels][^$vowels])*[$vowels]?$/;
26 push @frags, $frag if grep {m/$frag/} @$rest;
27 }
28 }
29 return [@frags];
30 }
Examples:
./ch-2.pl "relocate delocate allocate" "apple banana cherry" "navigate cavity gravity" \
"pedalgia pedalboard pedantic" "schoolmaster schoolhouse schooling"
Results:
relocate delocate allocate -> locate
apple banana cherry ->
navigate cavity gravity -> avi
pedalgia pedalboard pedantic -> peda
schoolmaster schoolhouse schooling -> ho ol
/;
Written on October 5, 2026