Task — Array degree

You are given an array of 2 or more non-negative integers.

Write a script to find out the smallest slice, ie contiguous subarray of the original array, having the degree of the given array. The degree of an array is the maximum frequency of an element in the array.

Examples

Example 1
Input: @array = (1, 3, 3, 2)
Output: (3, 3)
The degree of the given array is 2.
The possible subarrays having the degree 2 are as below:
(3, 3)
(1, 3, 3)
(3, 3, 2)
(1, 3, 3, 2)
And the smallest of all is (3, 3).

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

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

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

Example 5
Input: @array = (2, 1, 2, 1, 1)
Output: (1, 2, 1, 1)

Analysis

It seems sensible to start by writing a subroutine to return the degree of an array.

We know that the slice can't be any shorter than the degree of the original array, so that's a good start. Let's begin at that size and work up, and then in an inner loop check every slice of that size, and then the next size up and so on until we find a slice with the same degree as the original array.

There is a slight wrinkle, in that the answer may not be unique. For example 1, 1, 1, 2, 2, 2 has two slices - 1, 1, 1 and 2, 2, 2 - each of degree 3. I chose to output all the slices meeting the criteria, so my inner (position) loop does not immediately terminate if it finds a solution, but it does stop the outer (size) loop from going further.

Try it 

Script

#!/usr/bin/perl

# Peter Campbell Smith - 2022-10-31
# PWC 189 task 2

use v5.28;
use utf8;
use warnings;
binmode(STDOUT, ':utf8');

my (@tests, $test, @array, $degree, $size, $start, $slice_degree, @slice, $found);

@tests = ([1, 3, 3, 2], [1, 2, 1, 3], [1, 3, 2, 1, 2], [1, 1, 2, 3, 2], [2, 1, 2, 1, 1],
    [1, 5, 8, 6, 3, 4, 2, 6, 5, 7, 3, 4, 5, 1 ,3, 4, 2, 3, 5, 1, 2, 7, 4, 6, 2, 4, 1, 8, 4, 3],
    [1, 1, 1, 2, 2, 2]);

TEST: for $test (@tests) {
    @array = @$test;
    
    # get degree of supplied array
    $degree = get_degree(@array);   
    say qq[\nInput:  \@array = (]. join(', ', @array), qq[), degree $degree];
    
    # now test possible slices from shortest to longest
    $found = 0;
    SIZE: for $size ($degree .. scalar @array) {
        
        # ... and starting from the beginning up to the last position where rgere are still $size left
        for $start (0 .. scalar @array - $size) {
            @slice = @array[$start..$start + $size - 1];
            $slice_degree = get_degree(@slice);
            
            # do we have an answer?
            if ($slice_degree == $degree) {
                say qq[Output: (] . join(', ', @slice) . qq[), degree $slice_degree];
                $found = 1;
            }
        }
        
        # we have found answer(s) at this $size, so don't look at longer possibilities
        last SIZE if $found;
    }
}

sub get_degree {
    
    my ($degree, $j, %freq);
    
    # find the frequency of the most frequent element(s)
    $degree = 0;
    for $j (@_) {
        $freq{$j} ++;
        $degree = $freq{$j} if $freq{$j} > $degree;
    }
    return $degree;
}

Output

Input:  @array = (1, 3, 3, 2), degree 2
Output: (3, 3), degree 2

Input:  @array = (1, 2, 1, 3), degree 2
Output: (1, 2, 1), degree 2

Input:  @array = (1, 3, 2, 1, 2), degree 2
Output: (2, 1, 2), degree 2

Input:  @array = (1, 1, 2, 3, 2), degree 2
Output: (1, 1), degree 2

Input:  @array = (2, 1, 2, 1, 1), degree 3
Output: (1, 2, 1, 1), degree 3

Input:  @array = (1, 5, 8, 6, 3, 4, 2, 6, 5, 7, 3, 4, 5, 1, 3, 4, 2, 3, 5, 1, 2, 7, 4, 6, 2, 4, 1, 8, 4, 3), degree 6
Output: (4, 2, 6, 5, 7, 3, 4, 5, 1, 3, 4, 2, 3, 5, 1, 2, 7, 4, 6, 2, 4, 1, 8, 4), degree 6

Input:  @array = (1, 1, 1, 2, 2, 2), degree 3
Output: (1, 1, 1), degree 3
Output: (2, 2, 2), degree 3