Merge pull request #3923 from simongreen-net/swg-109

sgreen solution to challenge 109

3 files changed, 102 insertions, 2 deletions

diff --git a/challenge-109/sgreen/README.md b/challenge-109/sgreen/README.md
index f23432ca89..94ad2ed1db 100644
--- a/challenge-109/sgreen/README.md
+++ b/challenge-109/sgreen/README.md
@@ -1,3 +1,3 @@
-# The Weekly Challenge 108
+# The Weekly Challenge 109
 
-Solution by Simon Green. [Blog](https://dev.to/simongreennet/weekly-challenge-108-3di2)
+Solution by Simon Green. [Blog]()
diff --git a/challenge-109/sgreen/perl/ch-1.pl b/challenge-109/sgreen/perl/ch-1.pl
new file mode 100755
index 0000000000..69df6c10f7
--- /dev/null
+++ b/challenge-109/sgreen/perl/ch-1.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+use List::Util 'sum';
+
+sub _divisors {
+    my $number   = shift;
+    my @divisors = (0);
+
+    for my $i ( 2 .. $number / 2 ) {
+        if ( $number % $i == 0 ) {
+            # This number is a divisor
+            push @divisors, $i;
+        }
+    }
+
+    # Return the sum of the unique divisors
+    return sum(@divisors);
+}
+
+sub main {
+    my $numbers = shift // 20;
+    say join ', ', map { _divisors($_) } ( 1 .. $numbers );
+}
+
+main(@ARGV);
diff --git a/challenge-109/sgreen/perl/ch-2.pl b/challenge-109/sgreen/perl/ch-2.pl
new file mode 100755
index 0000000000..a754e34610
--- /dev/null
+++ b/challenge-109/sgreen/perl/ch-2.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+use List::Util 'sum';
+
+sub _get_permutations {
+    # A little recursive function to generate all permutations of the
+    #  sets of numbers.
+    my ( $remaining, $used ) = @_;
+    my @permutations = ();
+
+    if ( $#$remaining == 0 ) {
+        # We have a new permutation
+        return [ @$used, @$remaining ];
+    }
+
+    for my $i ( 0 .. $#$remaining ) {
+        # Use one of the remaining numbers (in the order of the array),
+        #  any recursively call this function
+        my @new_used      = ( @$used, $remaining->[$i] );
+        my @new_remaining = @$remaining;
+        splice( @new_remaining, $i, 1 );
+        push @permutations, _get_permutations( \@new_remaining, \@new_used );
+    }
+
+    return @permutations;
+
+}
+
+sub main {
+    my @numbers = @_;
+
+    # Sanity check
+    die "You must specify seven numbers\n" unless scalar(@numbers) == 7;
+    foreach (@numbers) {
+        die "$_ is not a number\n" unless /^\d+(?:\.\d+)?/;
+    }
+
+    # Define the values in each box
+    my @boxes = ( [ 0, 1 ], [ 1, 2, 3 ], [ 3, 4, 5 ], [ 5, 6 ] );
+
+    # Generate all permatations. There is only 5,040 of them
+    my @permutations = _get_permutations( [@numbers], [] );
+
+  P: foreach my $permutation (@permutations) {
+        # Calculate the sums for each box in this permutation
+        my @sums = ();
+        foreach my $box (@boxes) {
+            push @sums, sum( @$permutation[@$box] );
+
+            # This permutation is not the correct one
+            next P if $sums[-1] != $sums[0];
+        }
+
+        # We have a solution! Print the results and exit
+        my $letter = 'a';
+        foreach my $n (@$permutation) {
+            say "$letter = $n";
+            ++$letter;
+        }
+
+        return;
+    }
+
+    say 'No solution found!';
+}
+
+main(@ARGV);