Beauty and the nest
Weekly challenge 300 — 16 December 2024
Week 300: 16 Dec 2024
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:
$set[$i]
starts with the selection of elements
$ints[$i]
.
$ints[$ints[$i]]
, and then $ints[$ints[$ints[$i]]]
,
and so on.
$set[$i]
.Return the longest length of such a set.
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
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.
#!/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) . ')'; }
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