The weekly challenge 237 - Task 2: Maximise Greatness

 1 #!/usr/bin/perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-237/#TASK2
 3 #
 4 # Task 2: Maximise Greatness
 5 # ==========================
 6 #
 7 # You are given an array of integers.
 8 #
 9 # Write a script to permute the given array such that you get the maximum
10 # possible greatness.
11 #
12 ### To determine greatness, nums[i] < perm[i] where 0 <= i < nums.length
13 #
14 ## Example 1
15 ##
16 ## Input: @nums = (1, 3, 5, 2, 1, 3, 1)
17 ## Output: 4
18 ##
19 ## One possible permutation: (2, 5, 1, 3, 3, 1, 1) which returns 4 greatness as below:
20 ## nums[0] < perm[0]
21 ## nums[1] < perm[1]
22 ## nums[3] < perm[3]
23 ## nums[4] < perm[4]
24 #
25 ## Example 2
26 ##
27 ## Input: @ints = (1, 2, 3, 4)
28 ## Output: 3
29 ##
30 ## One possible permutation: (2, 3, 4, 1) which returns 3 greatness as below:
31 ## nums[0] < perm[0]
32 ## nums[1] < perm[1]
33 ## nums[2] < perm[2]
34 #
35 ############################################################
36 ##
37 ## discussion
38 ##
39 ############################################################
40 #
41 # Calculate all permutations and check the greatness for each permutation
42 # Keep the maximum
43 
44 use strict;
45 use warnings;
46 use Algorithm::Permute;
47 
48 maximise_greatness(1, 3, 5, 2, 1, 3, 1);
49 maximise_greatness(1, 2, 3, 4);
50 
51 sub maximise_greatness {
52    my @ints = @_;
53    print "Input: (" . join(", ", @ints) . ")\n";
54    my $max = 0;
55    my $p_iterator = Algorithm::Permute->new ( \@ints );
56    while(my @perm = $p_iterator->next) {
57       my $current = greatness( [@_], [@perm] );
58       $max = $current if $current > $max;
59    }
60    print "Output: $max\n";
61 }
62 
63 sub greatness {
64    my ($nums, $perm) = @_;
65    my @ints = @$nums;
66    my $greatness = 0;
67    foreach my $i (0..$#ints) {
68       $greatness++ if $nums->[$i] < $perm->[$i];
69    }
70    return $greatness;
71 }
72