The weekly challenge 371 - Task 2: Subset Equilibrium

  1 #!/usr/bin/env perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-371/#TASK2
  3 #
  4 # Task 2: Subset Equilibrium
  5 # ==========================
  6 #
  7 # You are given an array of numbers.
  8 #
  9 # Write a script to find all proper subsets with more than one element where
 10 # the sum of elements equals the sum of their indices.
 11 #
 12 ## Example 1
 13 ##
 14 ## Input: @nums = (2, 1, 4, 3)
 15 ## Output: (2, 1), (1, 4), (4, 3), (2, 3)
 16 ##
 17 ## Subset 1: (2, 1)
 18 ## Values: 2 + 1 = 3
 19 ## Positions: 1 + 2 = 3
 20 ##
 21 ## Subset 2: (1, 4)
 22 ## Values: 1 + 4 = 5
 23 ## Positions: 2 + 3 = 5
 24 ##
 25 ## Subset 3: (4, 3)
 26 ## Values: 4 + 3 = 7
 27 ## Positions: 3 + 4 = 7
 28 ##
 29 ## Subset 4: (2, 3)
 30 ## Values: 2 + 3 = 5
 31 ## Positions: 1 + 4 = 5
 32 #
 33 ## Example 2
 34 ##
 35 ## Input: @nums = (3, 0, 3, 0)
 36 ## Output: (3, 0), (3, 0, 3)
 37 ##
 38 ## Subset 1: (3, 0)
 39 ## Values: 3 + 0 = 3
 40 ## Positions: 1 + 2 = 3
 41 ##
 42 ## Subset 2: (3, 0, 3)
 43 ## Values: 3 + 0 + 3 = 6
 44 ## Positions: 1 + 2 + 3 = 6
 45 #
 46 ## Example 3
 47 ##
 48 ## Input: @nums = (5, 1, 1, 1)
 49 ## Output: (5, 1, 1)
 50 ##
 51 ## Subset 1: (5, 1, 1)
 52 ## Values: 5 + 1 + 1 = 7
 53 ## Positions: 1 + 2 + 4 = 7
 54 #
 55 ## Example 4
 56 ##
 57 ## Input: @nums = (3, -1, 4, 2)
 58 ## Output: (3, 2), (3, -1, 4)
 59 ##
 60 ## Subset 1: (3, 2)
 61 ## Values: 3 + 2 = 5
 62 ## Positions: 1 + 4 = 5
 63 ##
 64 ## Subset 2: (3, -1, 4)
 65 ## Values: 3 + (-1) + 4 = 6
 66 ## Positions: 1 + 2 + 3 = 6
 67 #
 68 ## Example 5
 69 ##
 70 ## Input: @nums = (10, 20, 30, 40)
 71 ## Output: ()
 72 #
 73 ############################################################
 74 ##
 75 ## discussion
 76 ##
 77 ############################################################
 78 #
 79 # We create all a temporary array with all elements from @nums
 80 # with their index appended after ":". That way, we can just
 81 # create all possible subsets by using Data::PowerSet's
 82 # powerset(). From the powerset, we discard the empty set as
 83 # well as all sets with only one element and the set that
 84 # contains all elements (as it is not a proper subset). We also
 85 # discard all non-matching subsets, with non-matching being the
 86 # ones where the sum of the elements and the sum of the indices
 87 # don't match (we us a little helper function to determine that).
 88 
 89 use v5.36;
 90 use Data::PowerSet qw(powerset);
 91 
 92 subset_equilibrium(2, 1, 4, 3);
 93 subset_equilibrium(3, 0, 3, 0);
 94 subset_equilibrium(5, 1, 1, 1);
 95 subset_equilibrium(3, -1, 4, 2);
 96 subset_equilibrium(10, 20, 30, 40);
 97 
 98 sub subset_equilibrium(@nums) {
 99     say "Input: (" . join(", ", @nums) . ")";
100     my $subsets = generate_subsets(@nums);
101     my @result = ();
102     foreach my $subset (@$subsets) {
103         next unless @$subset;
104         next unless is_matching($subset);
105         next if scalar(@$subset) == scalar(@nums); # all elements != proper subset
106         next if scalar(@$subset) <= 1; # not more than one element: discard
107         my @tmp = ();
108         foreach my $elem (@$subset) {
109             $elem =~ s/:.*//;
110             push @tmp, $elem;
111         }
112         push @result, [ @tmp ];
113     }
114     print "Output: (";
115     foreach my $elem (@result) {
116         print "[" . join(", ", @$elem) . "], "
117     }
118     say ")";
119 }
120 
121 sub is_matching($subset) {
122     my @elems = @$subset;
123     my $sum_elems = 0;
124     my $sum_index = 0;
125     foreach my $elem (@elems) {
126         my ($e, $i) = split /:/, $elem;
127         $sum_elems += $e;
128         $sum_index += $i;
129     }
130     return $sum_elems == $sum_index;
131 }
132 
133 sub generate_subsets(@elems) {
134     my @tmp = ();
135     foreach my $i (1..$#elems+1) {
136         push @tmp, "$elems[$i-1]:$i";
137     }
138     return powerset(@tmp);
139 }