Perl Weekly Challenge: Week 350

Challenge 1:

Good Strings

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

This one was quite easy though my solution is probably not the most elegant possible.

First we assign a variable to hold the count of good strings found.

my $count = 0;

Now starting from the 3rd character in $str (i.e. index 2) we look at the substrings consisting of the current character and the preceding two characters until we reach the end.

for 2 ..^ $str.chars -> $i {

We split the substring into three individual characters.

    my ($a, $b, $c) = $str.substr($i - 2, 3).comb;

If the three characters are all different from each other we have a good string; we can increment $count.

    if $a ne $b && $a ne $c && $b ne $c {
        $count++;
    }
}

Finally we print the value of $count.

say $count;

(Full code on Github.)

The Perl version works in exactly the same way.

my $count = 0;

for my $i (2 .. length($str) - 1) {
    my ($a, $b, $c) = split //, substr($str, $i - 2, 3);

    if ($a ne $b && $a ne $c && $b ne $c) {
        $count++;
    }
}

say $count;

(Full code on Github.)

Challenge 2:

Shuffle Pairs

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 B = A * k where 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.

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 1030 and 1130 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)

I must say at the outset that I'm not very satisfied with my solution. It works but it is very slow. Unfortunately I didn't have time to improve it but here it is anyway.

Again, we start by assigning a variable to hold the result,

my $total = 0;

Then for every number between $from and $to inclusive...

for $from .. $to -> $i {

...we create a variable to store rge number of shuffle pairs found.

    my $shufflePairs = 0;

We split up the current number into its constituent digits.

    my @digits = $i.comb;

If all the digits aren't unique, this number is not going to produce any shuffle pairs so we give up and move on to the next number.

    if @digits != @digits.unique {
        next;
    }

We use the .permutations() method to find all possible ways of arranging @digits and join them up into strings. I suspect this is where I could optmize my code the most.

For each of these permutations...

    for @digits.permutations.map({ .join }) -> $j {

If it is less than or the same as the original number, it is not going to be part of a shuffle pair if I understand the spec correctly so, in that case, we move on to the next permutation.

        if $j <= $i {
            next;
        }

If the permutation is a multiple of the original number, we have found a shuffle pair and can increment our count.

        if $j %% $i {
            $shufflePairs++;
        }

If the number of shuffle pairs found equals $count we can increment $total. Though there may be additional shuffle pairs, there is no point in looking for them for the purpose of this challenge so we move on to the next number.

        if $shufflePairs == $count {
            $total++;
            last;
        }
    }

}

say $total;

(Full code on Github.)

For the Perl version we have to supply permute() and unique() functions. The rest is the same as Raku (and just as bad efficiency-wise.)

my $total = 0;

for my $i ($from .. $to) {
    my $shufflePairs = 0;
    my @digits = split //, $i;

    if (@digits != unique(@digits)) {
        next;
    }

    for my $j (map {  join q{}, @{$_} } permute (@digits)) {
        if ($j <= $i) {
            next;
        }

        if ($j % $i == 0) {
            $shufflePairs++;
        }

        if ($shufflePairs == $count) {
            $total++;
            last;
        }
    }
}

say $total;

(Full code on Github.)

UPDATE: 12/16/2025

It turns out that my solution gives the wrong answer for example 4. After some investigation it seems I don't need this:

    if @digits != @digits.unique {
        next;
    }

All the digits don't need to be unique.

Also, as I suspected, going through all the permutations is what made the script so slow. Instead we should approach the problem from the other direction.

First, to make comparisons, we rearrange the current number so the smallest digits are first making this the shortest permutation of the number. In fact though, we could use any permutation; this is just the easist to calculate.

my $shortest = @digits.sort.join;

Then we repeatedly multiply the number by an increasing amount.

for 2 .. ∞ -> $j {
    my $candidate = $i * $j;

We could potentionally continue to infinity but that would be pointless. Instead we stop when the length of $candidate is longer than the length of the initial number because then it obviously can't be part of a shuffle pair with that number.

    if $candidate.chars > $i.chars {
        last;
    }

We rearrange $candidate as we did for $shortest and compare the two. If they are equal, this is a shuffle pair. Incrementing $total etc. remains the same as before.

    if $candidate.comb.sort.join eq $shortest {
        $shufflePairs++;
        if $shufflePairs == $count {
            $total++;
            last;
        }
    }
}

This is a couple of orders of magnitude faster than what I had originally.

For the sake of completeness, here is the updated Perl version.

my $shortest = join q{}, sort @digits;

One little problem I had was apparently you can't include 'inf' in a range in Perl. So I just arbitrarily picked 100 as the maximum. It's more than big enough.

for my $j (2 .. 100) {
    my $candidate = $i * $j;

    if (length $candidate > length $i) {
        last;
    }

    if ((join q{}, sort (split //, $candidate)) eq $shortest) {
        $shufflePairs++;
        if ($shufflePairs == $count) {
            $total++;
            last;
        }
    }
}