site.base_url }}/">The Bear's Den -->

The Bear's Den

Enter at your own risk

Consecutive Permutations

Task 1: Consecutive Sequence

Submitted by: Mohammad Sajid Anwar


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 run in \(\mathcal{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

Solution

At first I questioned I would be able to solve this task. The best I could think of was based on a sorted list, but as sorting an (unbound) list runs in \(\mathcal{O}(n \log n)\) time, this would not qualify as a valid solution.

But it is indeed possible with the aid of some data structures:

These two structures are handled in a single pass through the list of given numbers where five cases can be distinguished:

  1. The current number is not adjacent to any known sequence so far. This initiates a new sequence. The predecessor and successor are now wanted for the sequence to be extended.
  2. The current number has already been seen and can be skipped.
  3. The current number extends a lower sequence with a new high value. The successor is now wanted.
  4. The current number extends a higher sequence wit a new low value. The predecessor is now wanted
  5. The current number joins a lower and a higher sequence. The low and high wanted numbers remain the same.

All operations on the current number can be performed in \(\mathcal{O}(1)\) time.

In a second pass, the array @sequence is scanned for the longest sequence. As there cannot be more than n elements in @sequence, this pass runs in \(\mathcal{O}(n)\) time, too.

use v5.12;
use warnings;
use Data::Dump 'pp';

our $verbose = 1;

sub dbg {
    say $_[0], (pp($_[1])) x !!$_[1] if $verbose;
}

sub consecutive_sequence {
    dbg "got ", \@_;
    my @sequence;
    my %wanted;
    for my $i (@_) {
        dbg qq(processing "$i");
        if (exists $wanted{$i}) {
            next unless defined $wanted{$i};
            if (exists $wanted{$i}{hi} && !exists $wanted{$i}{lo}) {
                dbg "extending hi";
                $sequence[$wanted{$i}{hi}]{lo} = $i;
                $wanted{$i - 1}{hi} = $wanted{$i}{hi};
            } elsif (exists $wanted{$i}{lo} && !exists $wanted{$i}{hi}) {
                dbg "extending lo";
                $sequence[$wanted{$i}{lo}]{hi} = $i;
                $wanted{$i + 1}{lo} = $wanted{$i}{lo};
            } elsif (exists $wanted{$i}{lo} && exists $wanted{$i}{hi}) {
                dbg "joining hi and lo";
                my $hi = delete $sequence[$wanted{$i}{hi}];
                $sequence[$wanted{$i}{lo}]{hi} = $hi->{hi};
                $wanted{$hi->{hi} + 1}{lo} = $wanted{$i}{lo};
            }
        } else {
            dbg "new sequence";
            my %seq = (lo => $i, hi => $i);
            push @sequence, \%seq;
            $wanted{$i + 1}{lo} = $#sequence;
            $wanted{$i - 1}{hi} = $#sequence;
        }
        $wanted{$i} = undef;
        dbg "sequence: ", \@sequence;
        dbg "wanted: ", \%wanted;
    }
    my $max = {lo => 1, hi => 0};
    for my $seq (@sequence) {
        next unless defined $seq;
        $max = $seq if $seq->{hi} - $seq->{lo} > $max->{hi} - $max->{lo};
    }
    dbg "max sequence: ", $max;
    $max->{hi} > $max->{lo} ? $max->{hi} - $max->{lo} + 1 : -1;
}

See the full solution to task 1.

Task 2: Next Permutation

Submitted by: Mohammad Sajid Anwar


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)

Solution

This task can be solved using Math::Prime::Util’s permtonum, numtoperm and factorial. All that needs to be done is to transform between this task’s 1-based and PMU’s 0-based permutations.

One missing detail from the task description: There is no next permutation for the lexicographically largest one.

use strict;
use warnings;
use Math::Prime::Util qw(permtonum numtoperm factorial);

sub next_permutation {
    my @perm = map $_ - 1, @_;
    my $p = permtonum(\@perm) + 1;

    $p == factorial(@perm) ? () : map $_ + 1, numtoperm(@perm, $p);
}

See the full solution to task 2.


If you have a question about this post or if you like to comment on it, feel free to open an issue in my github repository.