Perl Weekly Challenge 350.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 350.
Task 1: Good Substrings
Submitted by: Mohammad Sajid Anwar
You are given a string.
Write a script to return the number of good substrings
of length three in the given string.
A string is good if there are no repeated characters.
Example 1
Input: $str = "abcaefg"
Output: 5
Good substrings of length 3: abc, bca, cae, aef and efg
Example 2
Input: $str = "xyzzabc"
Output: 3
Good substrings of length 3: "xyz", "zab" and "abc"
Example 3
Input: $str = "aababc"
Output: 1
Good substrings of length 3: "abc"
Example 4
Input: $str = "qwerty"
Output: 4
Good substrings of length 3: "qwe", "wer", "ert" and "rty"
Example 5
Input: $str = "zzzaaa"
Output: 0
I can use a substr to obtain succesive string fragments of length 3,
and use a regular expression to discard fragments with repeated
letters, and finally, count the surviving fragments. The result fits a
one-liner.
Examples:
perl -E '
for(@ARGV){$i=$_;say "$i -> ", 0+grep{!/(.).*\1/}map {substr$i,$_,3}0..length($_)-3}
' abcaefg xyzzabc aababc qwerty zzzaaa
Results:
abcaefg -> 5
xyzzabc -> 3
aababc -> 1
qwerty -> 4
zzzaaa -> 0
The full code is
1 # Perl weekly challenge 350
2 # Task 1: Good Substrings
3 #
4 # See https://wlmb.github.io/2025/12/01/PWC350/#task-1-good-substrings
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 S0 S1...
8 to count substrings of Sn of size 3 with no repeated letters.
9 FIN
10 for(@ARGV){
11 my $input=$_;
12 say "$input -> ", 0+grep{!/(.).*\1/} map {substr $input, $_, 3} 0..length($_)-3
13 }
Example:
./ch-1.pl abcaefg xyzzabc aababc qwerty zzzaaa
Results:
abcaefg -> 5
xyzzabc -> 3
aababc -> 1
qwerty -> 4
zzzaaa -> 0
#+endsrc
Task 2: Shuffle Pairs
Submitted by: E. Choroba
If two integers A <= B have the same digits but in different orders,
we say that they belong to the same shuffle pair if and only if there
is an integer k such that A = B * k. k is called the witness of the pair.
For example, 1359 and 9513 belong to the same shuffle pair, because
1359 * 7 = 9513.
Interestingly, some integers belong to several different shuffle pairs.
For example, 123876 forms one shuffle pair with 371628, and another with
867132, as 123876 * 3 = 371628, and 123876 * 7 = 867132.
Write a function that for a given $from, $to, and $count returns the number
of integers $i in the range $from <= $i <= $to that belong to at least $count
different shuffle pairs.
PS: Inspired by a conversation between Mark Dominus and Simon Tatham at
Mastodon.
Example 1
Input: $from = 1, $to = 1000, $count = 1
Output: 0
There are no shuffle pairs with elements less than 1000.
Example 2
Input: $from = 1500, $to = 2500, $count = 1
Output: 3
There are 3 integers between 1500 and 2500 that belong to shuffle pairs.
1782, the other element is 7128 (witness 4)
2178, the other element is 8712 (witness 4)
2475, the other element is 7425 (witness 3)
Example 3
Input: $from = 1_000_000, $to = 1_500_000, $count = 5
Output: 2
There are 2 integers in the given range that belong to 5 different shuffle pairs.
1428570 pairs with 2857140, 4285710, 5714280, 7142850, and 8571420
1429857 pairs with 2859714, 4289571, 5719428, 7149285, and 8579142
The witnesses are 2, 3, 4, 5, and 6 for both the integers.
Example 4
Input: $from = 13_427_000, $to = 14_100_000, $count = 2
Output: 11
6 integers in the given range belong to 3 different shuffle pairs, 5 integers belong
to 2 different ones.
Example 5
Input: $from = 1030, $to = 1130, $count = 1
Output: 2
There are 2 integers between 1020 and 1120 that belong to at least one shuffle pair:
1035, the other element is 3105 (witness k = 3)
1089, the other element is 9801 (witness k = 9)
(Note: there is a small mistake in the statement. Where it says A<=B it should say A>B)
A solution could be to generate all permutations of the digits of each candidate and test them for divisibility. That would be ridiculously slow. A simpler solution is to realize that k should be between 2 and 9, as otherwise the number of digits would necessarily increase. Thus, we can multiply each candidate by all numbers between 2 and 9 and test the digits of the result. To test the result I split, sort and join the digits and compare the resulting numbers, as it seems faster than counting digits and comparing their counts. The result can be fitted into a 2.5-liner.
perl -E '
for my($l,$h,$c)(@ARGV){$r=0;$n=$l;while($n<=$h){my $C=0;$d=d($n);for(2..9){
$D=d($n*$_);++$C if $d==$D;}++$r if $C>=$c;++$n}say "$l, $h, $c -> $r";}
sub d($x){join "", sort {$b<=>$a} split "", $x}
' 1 1000 1 1500 2500 1 1000000 1500000 5 13427000 14100000 2 1030 1130 1
Results:
1, 1000, 1 -> 0
1500, 2500, 1 -> 3
1000000, 1500000, 5 -> 2
13427000, 14100000, 2 -> 11
1030, 1130, 1 -> 2
Although the results are correct, the process is slow. It can be somewhat accelerated by using modular arithmetic, noticing that if the digits of the result are the same as the digits of the initial number, then, their sum is also the same! The sum of the digits of a number are congruent to the number itself modulo 9. Thus, if A=B*k and A has the same digits as B, then A%9=((B%9)*k)%9. If B%9==1, the only possible value for k is 1, which is the trivial result (each number is equal to itself), and thus we discard it. More generally, if B%9 is a relative prime of 9, then the only solution is k=1 and we discard it. Therefore, if there is a non-trivial solution, B%9 must be either 3, 6 or 0. In the first two cases, k can only take the values 4 or 7. For example, 3*4=12=3 mod 9, and 3*7=21=3 mod 9. If B%9=0, then k may be any number between 2 and 9. This yields a slightly more complicated but faster program.
perl -E '
for my($l,$h,$c)(@ARGV){$r=0;$n=$l;$n+=3-$n%3 if$n%3;while($n<=$h){my$C=0;$d=d($n);
for($n%9==0?(2..9):(4,7)){$D=d($n*$_);++$C if $d==$D}++$r if$C>=$c;$n+=3;}
say "$l, $h, $c -> $r";}sub d($x){join "", sort {$b<=>$a} split "", $x}
' 1 1000 1 1500 2500 1 1000000 1500000 5 13427000 14100000 2 1030 1130 1
Results:
1, 1000, 1 -> 0
1500, 2500, 1 -> 3
1000000, 1500000, 5 -> 2
13427000, 14100000, 2 -> 11
1030, 1130, 1 -> 2
The speedup was a factor of 5.2, not far from the expected speedup, performing 9+2+2 multiplications instead of 9*9 multiplications, about 6.2.
The full code is:
1 # Perl weekly challenge 350
2 # Task 2: Shuffle Pairs
3 #
4 # See https://wlmb.github.io/2025/12/01/PWC350/#task-2-shuffle-pairs
5 use v5.36;
6 use feature qw(try);
7 die <<~"FIN" unless @ARGV and @ARGV%3==0;
8 Usage: $0 f0 t0 c0 f1 t1 c1...
9 to find how many integers from fn up to tn have cn or more
10 shuffle pairs, i.e., integer multiples with the same digits.
11 FIN
12 my $result;
13 for my($low, $high, $count)(@ARGV){
14 try {
15 do {die "Only digits allowed: $_" unless /^\d+$/} for $low, $high, $count;
16 $result=0;
17 my $current=$low;
18 $current += 3 - $current%3 if $current%3; # skip upto multiple of 3
19 next if $count > 9;
20 while($current <= $high){
21 my $multiple_of_9 = $current%9==0;
22 next if !$multiple_of_9 && $count > 2; # at most two witnesses
23 my $pairs=0;
24 my $original=digits($current);
25 for($current%9==0?(2..9):(4,7)){
26 my $multiplied=digits($current*$_);
27 ++$pairs if $original==$multiplied;
28 }
29 ++$result if $pairs >= $count;
30 }
31 continue {
32 $current+=3; # next multiple of 3
33 }
34 }
35 catch($e){ warn $e; }
36 }
37 continue{
38 say "$low, $high, $count -> $result";
39 }
40
41 sub digits($x){
42 join "", sort {$b<=>$a} split "", $x;
43 }
Example:
./ch-2.pl 1 1000 1 1500 2500 1 1000000 1500000 5 13427000 14100000 2 1030 1130 1
Results:
1, 1000, 1 -> 0
1500, 2500, 1 -> 3
1000000, 1500000, 5 -> 2
13427000, 14100000, 2 -> 11
1030, 1130, 1 -> 2
/;