Task — Sequential substrings

You are given a list of integers and a group size greater than zero.

Write a script to split the list into equal groups of the given size where integers are in sequential order. If it can’t be done then print -1.

Analysis

I interpreted the requirement as being that the substrings each have to contain an increasing sequence of consecutive integers. I also deduced from the examples that the order of the initial list is not significant, so that for example 3, 1, 2 can be extracted as 1, 2, 3.

Given that, there are two consequences:

• A successful solution demands that the initial list has a length which is a multiple of the substring length.
• If there is a solution, it is unique as is demonstrated below.

Let's suppose the substring length is 3, and we start by sorting the given list, and that yields:

1, 2, 2, 3, 3, 4, 5, 6, 7

Consider the 1. The only substring it can possibly be in is 1, 2, 3. If we remove those figures from the list we are left with:

2, 3, 4, 5, 6, 7

If we once again consider the smallest remaining number - 2 - it can only be part of a 2, 3, 4 substring. If we continue, eliminating each substring which includes the smallest remining number, there is always a single (or no) solution. Hence any complete solution is unique.

So how to code that? I considered using an array, a hash or a string; none of these is ideal for deleting a member and then closing the gap. So I came up with a 'pool'. The given list is loaded into @pool such that $pool[$j] is the number of $j's in the list. So, for example with the initial list given above, $pool[1] is 1 (because there is only one 1), $pool[2] is 2 and so on with $pool[7] being 1.

Now we simply start with the first element of the sorted list, decrementing the relevant elements of @pool when we identify a compliant substring. For example, we consider 1, 2, 3, we note that all of $pool[1], $pool[2] and $pool[3] are > 1, and therefore decrement these three elements of @pool. Now, the smallest remeaining number in @pool is 2, so we look to see if $pool[2], [3] and [4] are all > 0 and if so decrement them, and so on until the pool is empty.

Or, if at any point we can't make a valid substring starting with the currently smallest number in the pool, we can immediately deduce that the given list cannot be split compliantly.

Try it 

Script

#!/usr/bin/perl

use v5.16;    # The Weekly Challenge - 2023-04-10
use utf8;     # Week 212 task 2 -
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

sequences(3, [8, 7, 3, 5, 2, 1, 0, 4, 6, 9]);
sequences(3, [1, 2, 3, 1, 2, 3, 2, 3, 4, 4, 5, 6]);
sequences(4, [4, 5, 6, 7, 123, 122, 121, 120, 120, 121, 122, 123]);

sub sequences {
    
    my ($length, @list, $j, @pool, $rubric, $good, $k);
    
    # initialise
    $length = $_[0];
    @list = sort {$a <=> $b} @{$_[1]};
    
    say qq[\nInput: \@list = (] . join(', ',@{$_[1]}) . qq[), length = $length];
    
    # make pool (see blog) - $pool[$j] is the no of $j's in $list
    for $j (0 .. scalar @list - 1) {
        $pool[$list[$j]] ++;
    }
    
    # start looping
    $j = $list[0];
    while (1) {
        
        # nothing left
        last if $j > $list[scalar @list - 1];
        
        # is there any a(nother) $j entry?
        $pool[$j] += 0;
        if ($pool[$j] > 0) {
        
            # is there a sequence starting here?
            $good = 1;
            for $k ($j .. $j + $length - 1) {
                $pool[$k] += 0;
                $good = 0 unless $pool[$k] > 0;
            }
            
            # yes there is
            if ($good) {
                $rubric .= '(';
                
                # take members of sequence out of pool
                for $k ($j .. $j + $length - 1) {
                    $pool[$k] --;
                    $rubric .= qq[$k, ];
                }
                $rubric = qq[] . substr($rubric, 0, -2) . q[), ];
            } else {
                say qq[Output: -1 ($j cannot be part of a substring)];
                return;
            }
        }
        
        # try next pool member unless there is another $j
        $j ++ unless $pool[$j];
    }
    say qq[Output: ] . substr($rubric, 0, -2);
}

Output

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

Input: @list = (1, 2, 3, 1, 2, 3, 2, 3, 4, 4, 5, 6), length = 3
Output: (1, 2, 3), (1, 2, 3), (2, 3, 4), (4, 5, 6)

Input: @list = (4, 5, 6, 7, 123, 122, 121, 120, 120, 121, 122, 123), length = 4
Output: (4, 5, 6, 7), (120, 121, 122, 123), (120, 121, 122, 123)