Peter
Peter Campbell Smith

Beauty and the nest

Weekly challenge 300 — 16 December 2024

Week 300: 16 Dec 2024

Task 2

Task — Nested array

You are given an array of integers, @ints of length $n containing a permutation of the numbers in the range 0 .. $n - 1.

Write a script to build a set:

@set = $ints[$i], $ints[$ints[$i]], 
   $ints[$ints[$ints[$i]]], ...
subject to the following rules:
  • The first element in $set[$i] starts with the selection of elements $ints[$i].
  • The next element is $ints[$ints[$i]], and then $ints[$ints[$ints[$i]]], and so on.
  • We stop adding right before a duplicate element occurs in $set[$i].

Return the longest length of such a set.

Examples


Example 1
Input: @ints = (5, 4, 0, 3, 1, 6, 2)
Output: 4
ints[0] = 5
ints[1] = 4
ints[2] = 0
ints[3] = 3
ints[4] = 1
ints[5] = 6
ints[6] = 2
One of the longest sets set[k]:
set[0] = {ints[0], ints[5], ints[6], ints[2]} = 
   {5, 6, 2, 0}

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

Analysis

A little reflection shows that every member of @ints is in one and only one loop (which might have length 1).

With that insight it is only necessary to start with each element not yet identified as being in any loop, and to follow round its loop until getting back to the start, while keeping track of the longest loop seen so far.

Try it 

Try running the script with any input:



example: 5, 4, 0, 3, 1, 6, 2

Script


#!/usr/bin/perl

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

use v5.26;    # The Weekly Challenge - 2024-12-16
use utf8;     # Week 300 - task 2 - Nested array
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';

nested_array([5, 4, 0, 3, 1, 6, 2]);
nested_array([1, 0,  4, 2, 3,  8, 10, 7, 9, 6, 5]);
nested_array([0, 1, 2, 3, 4, 5]);
nested_array([0, 2, 1]);

sub nested_array {
    
    my (@ints, $s, $loop, $t, $length, $longest, $best, @seen);
    
    #initialise
    @ints = @{$_[0]};
    $longest = 0;
    
    # find a new loop starting at $s 
    for $s (0 .. $#ints) {
        next if defined $seen[$s];
        
        # start the loop here
        $loop = qq[$s, ];
        $t = $s;
        
        # follow the loop till it gets back to the start
        do {
            $t = $ints[$t];
            $loop .= qq[$t, ];
            $seen[$t] = 1;
        } until ($t == $s);
        
        # see if it's the longest
        $length = ($loop =~ s|,|,|g) - 1;
        if ($length > $longest) {
            $longest = $length;
            $best = $loop;
        }
    }
    
    say qq[\nInput:  \@ints = (] . join(', ', @ints) . ')';
    say qq[Output: $longest - (] . substr($best, 0, -2) . ')';
}

Output


Input:  @ints = (5, 4, 0, 3, 1, 6, 2)
Output: 4 - (0, 5, 6, 2, 0)

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

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

Input:  @ints = (0, 2, 1)
Output: 2 - (1, 2, 1)

 

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