1 #!/usr/bin/perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-206/#TASK2
 3 #
 4 # Task 2: Array Pairings
 5 # ======================
 6 #
 7 # You are given an array of integers having even number of elements..
 8 #
 9 # Write a script to find the maximum sum of the minimum of each pairs.
10 #
11 ## Example 1
12 ##
13 ## Input: @array = (1,2,3,4)
14 ## Output: 4
15 ##
16 ## Possible Pairings are as below:
17 ## a) (1,2) and (3,4). So min(1,2) + min(3,4) => 1 + 3 => 4
18 ## b) (1,3) and (2,4). So min(1,3) + min(2,4) => 1 + 2 => 3
19 ## c) (1,4) and (2,3). So min(1,4) + min(2,3) => 2 + 1 => 3
20 ##
21 ## So the maxium sum is 4.
22 #
23 ## Example 2
24 ##
25 ## Input: @array = (0,2,1,3)
26 ## Output: 2
27 ##
28 ## Possible Pairings are as below:
29 ## a) (0,2) and (1,3). So min(0,2) + min(1,3) => 0 + 1 => 1
30 ## b) (0,1) and (2,3). So min(0,1) + min(2,3) => 0 + 2 => 2
31 ## c) (0,3) and (2,1). So min(0,3) + min(2,1) => 0 + 1 => 1
32 ##
33 ## So the maximum sum is 2.
34 #
35 ############################################################
36 ##
37 ## discussion
38 ##
39 ############################################################
40 #
41 # We could this as follows:
42 # - First, we create all possible pairings
43 # - Then we calculate the sum of the minimums of each pair for
44 #   each of the possible pairings
45 # - Then we keep the maximum of those sums
46 # However, it is more efficient to do this on the go:
47 # - Create a recursive function that takes the first element
48 #   of the array, then for each remaining element:
49 #   - calculate the minumum of this element and the first one
50 #   - add the maximum sum of all remaining elements
51 
52 use strict;
53 use warnings;
54 
55 array_pairings(1,2,3,4);
56 array_pairings(0,2,1,3);
57 array_pairings(0,2,1,3,6,9);
58 
59 sub array_pairings {
60    my @array = @_;
61    # Output is here, the calculation happens in an extra function
62    print "Input: (" . join(", ", @array) . ")\n";
63    print "Output: " . max_array_pairings(@array) . "\n";
64 }
65 
66 sub max_array_pairings {
67    my @array = @_;
68    die "Not an even number of elements" if @array % 2;
69    # if the array is empty, we can return 0 and are done
70    return 0 unless @array;
71    my $maximum = 0;
72    # pick the first element of the array for all possible pairings with it
73    my $first = shift @array;
74    foreach my $index (0..$#array) {
75       # for all possible pairings with the first element, calculate the minimum of the pairing
76       # plus the result of the recursive function call
77       my $current = min($first, $array[$index]) + max_array_pairings(@array[0..$index-1], @array[$index+1..$#array]);
78       # if our current result is greater than the maximum so far, we have a new maximum
79       $maximum = $current if $current > $maximum;
80    }
81    return $maximum;
82 }
83 
84 # Helper function to calculate the minimum element of an array
85 # Of course we could use
86 #    use List::Util qw(min);
87 # instead, but on the other hand, this is fast to write so let's
88 # implement it ourselves :)
89 sub min {
90    my @array = @_;
91    die "Can't calculate minimum of empty array!\n" unless @array > 0;
92    my $minimum = $array[0];
93    foreach my $elem (@array) {
94       $minimum = $elem if $elem < $minimum;
95    }
96    return $minimum;
97 }
98