Seize the greatness

Weekly challenge 237 — 9 October 2023

Week 237 - 9 Oct 2023

Task 2

You are given an array of integers, @nums. Write a script to find of permutation @perm of @nums that gives the maximum possible greatness. Greatness is the number of elements where $perm[$i] > $nums[$i] for all $i.

Example 1Input: @nums = (1, 3, 5, 2, 1, 3, 1) Output: 4 One possible permutation: (2, 5, 1, 3, 3, 1, 1) which returns 4 greatness as below: nums[0] < perm[0] nums[1] < perm[1] nums[3] < perm[3] nums[4] < perm[4]Example 2Input: @ints = (1, 2, 3, 4) Output: 3 One possible permutation: (2, 3, 4, 1) which returns 3 greatness as below: nums[0] < perm[0] nums[1] < perm[1] nums[2] < perm[2]

The obvious way to do this is to use one of the permutations modules to generate all the permutations
of @nums and test each of them for greatness. That works, but gets increasingly slow as the size of @nums
- call it `$n`

- increases.

But there is a better way.

Let's make two observations:

- The maximum possible greatness is
`$n - 1`

. That is because there can never be a member of`@perms`

that is greater than the largest member of`@nums`

. Similarly, there can never be a member of`@nums`

that is smaller than the smallest member of`@perms`

. So while it*may*be possible to arrange`$n - 1`

members of`@perms`

so that they are less than the corresponding member of`@nums`

, you will then be left with the largest member of`@nums`

and the smallest member of`@perms`

, which are clearly not 'great'. - The other observation is that the order of the members in
`@nums`

is not significant. If we reorder`@nums`

, it will still have the same set of permutations and the same number of nums/perms pairs will show greatness.

So, in the light of the above, let's first sort `@nums`

into ascending order. And let's for now assume that all the members of `@nums`

are distinct, that is with no number
duplicated. So here's an example, once we've sorted it:

`1, 2, 3, 4, 5`

Now let's choose the permutation which consists of rotating `@nums`

one place to the left:

```
@nums: 1, 2, 3, 4, 5
```

@perms: 2, 3, 4, 5, 1

And there we are: the first four pairs are great and the last deals with the largest nums and smallest perms, so we have achieved a greatness of the maximum possible, 4. We could then of course rearrange the nums/perms pairs in the order nums were originally given to us.

But what if there *are* duplications in `@nums`

? Let's apply the same logic:

```
@nums: 1, 2, 3, 3, 4
```

@perms: 2, 3, 3, 4, 1

We can see that the greatness has declined to 3 because the middle pair is not great and indeed that is the correct answer in this case - but not always. However, I have determined by experiment on >200 cases that repeating the left shift, several times if necessary, will always find the greatest permutation.

I have coded both the all-permutations and my methods and have timed them both. You can see that for a 9-element @nums with no repetition the permutations method takes about 2.5 seconds, whereas my method takes a mere 85 microseconds, and comes up with the same permutation (although in some cases it comes up with a different, equally great, permutation).

#!/usr/bin/perl use v5.16; # The Weekly Challenge - 2023-10-02 use utf8; # Week 237 task 2 - Maximise greatness use strict; # Peter Campbell Smith use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge use Algorithm::Loops 'NextPermuteNum'; use Time::HiRes ('gettimeofday', 'tv_interval'); binmode(STDOUT, ':utf8'); my ($j, $k, @nums); say qq[Output1 uses the permutations method and Output2 uses the algorithm described in my analysis.]; maximise_greatness(1, 3, 5, 2, 1, 3, 1); maximise_greatness(1, 2, 3, 4); maximise_greatness(9, 6, 3, 5, 1, 0, 8, 4, 14); maximise_greatness(1, 2, 3, 1, 2, 3, 1, 2, 3); sub maximise_greatness { my (@nums, @perms, $last, $greatness, $greatness_perm, $count, $j, $greatest, %seen, $distinct, $k, @sorted, @order, $n, $m, @best_perm, $t0, $elapsed); # FULL SEARCH OF PERMUTATIONS @nums = @_; $t0 = [gettimeofday]; @perms = sort { $a <=> $b} @nums; $last = scalar @nums - 1; $greatness = 0; say qq[\nInput: \@nums = (] . join(', ', @nums) . ')'; # loop over permutations do { # check list for greatness $count = 0; for $j (0 .. $last) { $count ++ if $nums[$j] < $perms[$j]; last if $count + $last - $j <= $greatness; } # found a better one if ($count > $greatness) { $greatness = $count; $greatness_perm = join(', ', @perms); } $k ++; } while (NextPermuteNum(@perms) and $greatness != $last); $elapsed = int(tv_interval($t0) * 1000000); say qq[Output1: \@perms = ($greatness_perm)]; say qq[ greatness = $greatness ($k permutations, time ${elapsed}μs)]; # PETER'S IMPROVED METHOD $t0 = [gettimeofday]; @sorted = sort { $a <=> $b} @nums; @perms = @sorted; $greatness = 0; # loop over left shifts K: for $k (0 .. $last - 1) { push(@perms, shift @perms); $count = 0; for $j (0 .. $last) { $count ++ if $sorted[$j] < $perms[$j]; if ($count > $greatness) { $greatness = $count; @best_perm = @perms; } last K if $greatness == $last; } } # unsort @best_perm into the same order as @nums for $j (0 .. $last) { $n = $nums[$j]; for $k (0 .. $last) { if ($sorted[$k] == $n) { $m = $k; $sorted[$k] = 99999; last; } } $order[$j] = $best_perm[$m]; } $elapsed = int(tv_interval($t0) * 1000000); say qq[Output2: \@perms = (] . join(', ', @order) . qq[)]; say qq[ greatness = $greatness (time ${elapsed}μs)]; }

Output1 uses the permutations method and Output2 uses the algorithm described in my analysis. Input: @nums = (1, 3, 5, 2, 1, 3, 1) Output1: @perms = (1, 1, 1, 3, 2, 5, 3) greatness = 4 (420 permutations, time 8005μs) Output2: @perms = (1, 5, 1, 3, 2, 1, 3) greatness = 4 (time 152μs) Input: @nums = (1, 2, 3, 4) Output1: @perms = (2, 3, 4, 1) greatness = 3 (10 permutations, time 275μs) Output2: @perms = (2, 3, 4, 1) greatness = 3 (time 61μs) Input: @nums = (9, 6, 3, 5, 1, 0, 8, 4, 14) Output1: @perms = (14, 8, 4, 6, 3, 1, 9, 5, 0) greatness = 8 (355500 permutations, time 2484374μs) Output2: @perms = (14, 8, 4, 6, 3, 1, 9, 5, 0) greatness = 8 (time 77μs) Input: @nums = (1, 2, 3, 1, 2, 3, 1, 2, 3) Output1: @perms = (2, 3, 1, 2, 3, 1, 2, 3, 1) greatness = 6 (1680 permutations, time 13577μs) Output2: @perms = (2, 3, 1, 2, 3, 1, 2, 3, 1) greatness = 6 (time 80μs)

Peter Campbell Smith is hereby placed in the public domain