Peter
Peter Campbell Smith

Sequential permutations

Weekly challenge 294 — 4 November 2024

Week 294: 4 Nov 2024

Task 2

Task — 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.

Examples


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)

Analysis

Let's start by assuming for now - as in the examples - that the elements of @ints are unique.

The first thing to notice is the possibility that @ints might be the lexicograpically last permutation of its elements, in which case there is no next permutation. This last permutation is the one with the elements monotonically decreasing, eg 7, 5, 4, 2, 1. So my code deals with that first.

For the rest, I am sure that there is a neat way that given one permutation, you can deduce the next. For example, if the last element is smaller than the second last, then the next permutation simply has these two elements reversed:

4, 5, 7, 1, 2 => 4, 5, 7, 2, 1

But it gets more complicated. For example:

5, 7, 4, 2, 1 => 7, 1, 2, 4, 5

So I went for the easy solution: generate all the permutations, scan down until we find @ints and then the answer is the next one. I used Algorithm::Combinatorics 'permutations' to generate the permutations because it's fast, it generates them one-by-one, so you don't have to wait until it's generated the whole set, and if you sort @ints, it generates the permutations in lexicographic order.

This is simple to code, but the snag is that it gets exponentially slower as the number of elements in @ints increases. On my computer it works fine up to about 10 elements, but then begins to struggle unless the supplied permutation is early in the sorted list.

So what happend if the elements of @ints are not unique? For example:

 @ints = 2, 3, 5, 7, 7, 9

@perm1 = 2, 3, 5, 7, 7, 9
@perm2 = 2, 3, 5, 7, 7, 9

In this case, my algorithm will assume that the first of these (perm1) is @ints, and will return perm2. You might regard that as correct - or you might not.

Conversely, in the special case of @ints being the last permutation in lexicographical order, my algorithm will report it as last, even thought it might be followed by an identical one, such as:

@ints                    = 7, 6, 5, 4, 4
last but one permutation = 7, 6, 5, 4, 4
last permutation         = 7, 6, 5, 4, 4

However, if you don't like that, it's simple enough to skip duplicates.

Try it 

Try running the script with any input:



example: 7, 5, 3, 8, 1 - max of 10 numbers, please

Script


#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2024-11-04
use utf8;     # Week 294 - task 2 - Next permutation
use warnings; # Peter Campbell Smith
use Algorithm::Combinatorics 'permutations';
binmode STDOUT, ':utf8';

next_permutation(1, 2, 3);
next_permutation(2, 1, 3);
next_permutation(3, 1, 2);
next_permutation(1, 2, 4, 3);
next_permutation(9, 11, 5, 3, 1);
next_permutation(4, 3, 2, 1);

my @ints;
push @ints, int(rand(20)) for 0 .. 9;
next_permutation(@ints);

sub next_permutation {
    
    my (@ints, @sort_ints, $j, $iter, $next, $ok);
    
    # initialise
    @ints = @_;
    @sort_ints = sort { $a <=> $b } @ints;
    
    # if @ints is monotonically decreasing this is the last
    $ok = 0;
    for $j (1 .. $#ints) {
        $ok |= 1 if $ints[$j - 1] < $ints[$j];
    }   
    
    # get current permutation in lexicographic order
    if ($ok) {
        $iter = permutations(\@sort_ints);
        ITER: while ($next = $iter->next) {
            for $j (1 .. $#ints) {
                next ITER unless $ints[$j] == $next->[$j];
            }   
            last ITER;
        }
        $next = $iter->next;   # the next iteration
    }
  
    say qq[\nInput:  \@ints = (] . join(', ', @_) . ')';
    say qq[Output:         ] . ($ok ? '(' . join(', ', @$next) . ')' :
        'none: this is the last iteration');
}

Output


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

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

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

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

Input:  @ints = (9, 11, 5, 3, 1)
Output:         (11, 1, 3, 5, 9)

Input:  @ints = (4, 3, 2, 1)
Output:         none: this is the last iteration

Input:  @ints = (17, 9, 5, 10, 4, 6, 16, 18, 10, 13)
Output:         (17, 9, 5, 10, 4, 6, 16, 18, 13, 10)

 

Any content of this website which has been created by Peter Campbell Smith is in the public domain