Challenge 294 solutions in Perl by Matthias Muth

These are my Challenge 294 Task 1 and 2 solutions in Perl
for The Weekly Challenge - Perl and Raku.

Summary

Task 1: Consecutive Sequences
$O(n)$ solution using a small data structure and a lookup hash to keep track of 'streaks' (consecutive sequences) and to merge them with new numbers as they are processed.

Task 2: Next Permutation
Working 'locally' to flip numbers to get the next permutation, without the need to create all permutations first.

Code:
Find the complete source code for both tasks, including more tests, on Github.

Task 1: Consecutive Sequence

You are given an unsorted array of integers, @ints.
Write a script to return the length of the longest consecutive elements sequence. Return -1 if none found. The algorithm must runs in O(n) time.

Example 1
Input: @ints = (10, 4, 20, 1, 3, 2)
Output: 4
The longest consecutive sequence (1, 2, 3, 4).
The length of the sequence is 4.

Example 2
Input: @ints = (0, 6, 1, 8, 5, 2, 4, 3, 0, 7)
Output: 9

Example 3
Input: @ints = (10, 30, 20)
Output: -1

Oh. Big Oh. $O(n)$ !

This restriction means that the simplest solution, sorting the array and then walking through the ordered numbers, is not allowed. That's because sort has an $O(n \log{} n)$ time complexity.

So what we are allowed to do for $O(n)$ is to walk through the array. As long as we don't use another loop within a loop, we can even walk through the array several times. This only means that the runtime spent for each number is slightly higher, but this still scales linearly with rising $n$ . Actually $O(2n)$ is the same as $O(n)$ .

In fact I do walk through the data twice! I use uniq on the input data, as a first pass (Example 2 contains a 0 twice!). I do this to make sure that double entries do not disturb the detection of sequences.

Let's call a 'consecutive sequence' a 'streak' for short.
We need to build up the 'streaks' as we encounter the numbers, one by one.
The data structure I use for representing a streak is a simple hash:

    $streak = { FROM => $a, TO => $b };

When a new number is encountered, I try to merge that number with any streak that already exists at the number's immediate left or immediate right.

For knowing whether those neighboring streaks already exists , I keep a lookup hash, %streaks. For every streak I create, I put a reference to the streak's data structure into that lookup hash, one with its starting number as the key, and one with its ending number. Thus, to access the left and right neighboring streaks for any new number $n, I only need to check $streaks{ $n - 1 } and $streaks{ $n + 1 }.. And once I have those, I know their 'other ends': the left streak's starting number, and the right streak's ending number. I then can create a new streak that covers them all, the left streak, the new number, and the right streak (if they exist, that is).

What is left to do then is to update the lookup table. I delete any references to the left and right streaks that will not be needed anymore, and I store references to the merged streak in the lookup hash at its starting and ending numbers.

For returning the length of the longest streak in the end, I check whether the new one is longer than what we already have, and update accordingly.

I have left the comments inside the code to make it easier to follow:

use v5.36;
use List::Util qw( uniq );

sub consecutive_sequence_using_hash( @ints ) {
    my $max_streak_length = -1;
    my %streaks;
    for my $n ( uniq @ints ) {
        # Create a new streak from this number,
        # possibly merged with any existing adjacent streaks
        # to the left or to the right.
        my ( $left, $right ) =
            ( $streaks{ $n - 1 }, $streaks{ $n + 1 } );
        my ( $from, $to ) = (
            $left ? $left->{FROM} : $n,
            $right ? $right->{TO} : $n,
        );
        my $streak = { FROM => $from, TO => $to };

        # Update the lookup entries:
        # Remove any entries that are *inside* the merged streak,
        # and add or update entries at the streak borders.
        delete $streaks{ $left->{TO} }
            if $left;
        delete $streaks{ $right->{FROM} }
            if $right;
        $streaks{$from} = $streaks{$to} = $streak;

        # Update the maximum length if this is a streak
        # (not just a single number) and it's longer than what we have.
        $max_streak_length = $to - $from + 1
            if $to > $from && $to - $from + 1 > $max_streak_length;
    }
    return $max_streak_length;
}

No loops inside!
I think this is proper $O(n)$ solution.

Task 2: Next Permutation

You are given an array of integers, @ints.
Write a script to find out the next permutation of the given array.
The next permutation of an array of integers is the next lexicographically greater permutation of its integer.

Example 1
Input: @ints = (1, 2, 3)
Output: (1, 3, 2)
Permutations of (1, 2, 3) arranged lexicographically:
(1, 2, 3)
(1, 3, 2)
(2, 1, 3)
(2, 3, 1)
(3, 1, 2)
(3, 2, 1)

Example 2
Input: @ints = (2, 1, 3)
Output: (2, 3, 1)

Example 3
Input: @ints = (3, 1, 2)
Output: (3, 2, 1)

A simple, but compute-intensive solution would be to create all permutations of the numbers involved, then sort them ('lexicographically'), then find the entry that corresponds to the permutation that is given, and then return the next one.
Actually I don't like this approach too much, because in my experience, anything that has to do with permutations or combinations has a tendency to use a lot of time , or a lot of memory, or both, very fast.

Let's find a solution that works 'locally'!

In order to modify an existing permutation to the next higher one, we need to find the number with the lowest significance that can be increased.
That means that we start at the right end (least significant), and find the first number that is lower than its right neighbor. All numbers at the right of that are ordered, highest first, so they can't be 'incremented'.

What if we didn't find any number that is lower than its right neighbor?
In that case, all numbers are ordered, highest first. This must be the last permutation possible. Which means that the next permutation will restart from the beginning of the cycle of all permutations.
In the first permutation, the numbers are ordered lowest first. To get there, we can just reverse that highest permutation sequence of numbers, and we can return that as the result.

If that's not the case, and we do have found a number that can be 'incremented', we need to find the next higher number to replace this number with.
We only look in the right part of the permutation, because using any number from further left would change the order more than we want.
We are looking for the lowest possible number that still is higher than our number.

Once we have found that replacement number, we exchange the two numbers.
We then have 'increased' our number by the next possible higher value of all permutations of the right part. At the same time, we have decreased the replacement number to the next possible lower number. So the ordering of the right part thus still is 'highest to lowest'. As we need the 'first' permutation of the right part, we can just reverse this.

That's it! We have found the lowest possible increment.

Again, I have left the comments in the code for easier following.

use v5.36;

sub next_permutation( @ints ) {
    return @ints
        if @ints <= 1;

    # Starting from the end, find the first number
    # that is lower than the one following it.
    my $index = $#ints;
    while( $index > 0 && $ints[ --$index ] gt $ints[ $index + 1 ] ) {
        # Everything is in the loop condition.
    }

    # No lower number found?
    # Then we are at the end of the permutations.
    return reverse @ints
        if $index == 0;

    my $value = $ints[$index];

    # Find the next highest value within the right part,
    # for using it to replace the current value.
    # (Remember that maybe not all values in the right part are higher!)
    # It has to be higher than the one to substitute, but the
    # lowest possible one.
    my ( $index_2, $replacement ) = ( $index + 1, $ints[ $index + 1 ] );
    for ( $index_2 + 1 .. $#ints ) {
        ( $index_2, $replacement ) = ( $_, $ints[$_] )
            if $value lt $ints[$_] lt $replacement;
    }

    # Swap the two numbers.
    @ints[ $index, $index_2 ] = @ints[ $index_2, $index ];

    # We know that the right side is sorted, highest first.
    # to have it sorted lowest first, we just need to reverse it.
    @ints[ $index + 1 .. $#ints ] =
        reverse @ints[ $index + 1 .. $#ints ];

    return @ints;
}

If we run this several times in a row, we will get a 'consecutive sequence of permutations'.
How nice for the title of this blog, combining the two tasks!

Thank you for the challenge!

Find the complete source code for both tasks, including tests, on Github.