sgreen solution for challenge 082

4 files changed, 89 insertions, 2 deletions

diff --git a/challenge-082/sgreen/README.md b/challenge-082/sgreen/README.md
index fde0cedfbd..669247f1fc 100644
--- a/challenge-082/sgreen/README.md
+++ b/challenge-082/sgreen/README.md
@@ -1,3 +1,3 @@
-# The Weekly Challenge 081
+# The Weekly Challenge 082
 
-Solution by Simon Green. [Blog](https://dev.to/simongreennet/the-weekly-challenge-081-1jje)
+Solution by Simon Green. [Blog](https://dev.to/simongreennet/weekly-challenge-082-3a9d)
diff --git a/challenge-082/sgreen/blog.txt b/challenge-082/sgreen/blog.txt
new file mode 100644
index 0000000000..1d83fd2f39
--- /dev/null
+++ b/challenge-082/sgreen/blog.txt
@@ -0,0 +1 @@
+https://dev.to/simongreennet/weekly-challenge-082-3a9d
diff --git a/challenge-082/sgreen/perl/ch-1.pl b/challenge-082/sgreen/perl/ch-1.pl
new file mode 100755
index 0000000000..b97c8b0490
--- /dev/null
+++ b/challenge-082/sgreen/perl/ch-1.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw(say);
+
+use List::Util qw(min);
+
+sub main {
+    my @values  = @_;
+    my @factors = ();
+
+    die "You must specify at least two values\n" if scalar(@values) < 2;
+    foreach (@values) {
+        die "Value '$_' is not a positive number\n"
+          unless /^[1-9][0-9]*$/;
+    }
+
+    my $min = min(@values);
+  OUTER: foreach my $number ( 1 .. $min ) {
+        foreach my $value (@values) {
+            next OUTER if $value % $number;
+        }
+
+        push @factors, $number;
+    }
+
+    say join ', ', @factors;
+
+}
+
+main(@ARGV);
diff --git a/challenge-082/sgreen/perl/ch-2.pl b/challenge-082/sgreen/perl/ch-2.pl
new file mode 100755
index 0000000000..8931338799
--- /dev/null
+++ b/challenge-082/sgreen/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw(say);
+
+sub _remove_character {
+    my ( $c, $words ) = @_;
+    my @array = ();
+
+    for my $i ( 0 .. $#$words ) {
+        # We've exhausted all the characters from this word.
+        next if $words->[$i] eq '';
+
+        # The first remaining letter in this word is not what we want.
+        next if substr( $words->[$i], 0, 1 ) ne $c;
+
+        # Add to the array striping the letter we used for the word.
+        push @array,
+          [ map { $_ == $i ? substr( $words->[$_], 1 ) : $words->[$_] }
+              0 .. $#$words ];
+    }
+    return @array;
+}
+
+sub main {
+    my @words  = @_;
+    my $target = pop(@words);
+
+    # Sanity check
+    die "You must enter at least three strings" unless scalar(@words) >= 2;
+
+    # If the length of the target is not the sum of the other
+    #  strings, we can exit early
+    return 0 if length($target) != length( join( '', @words ) );
+
+    my @remaining = ( \@words );
+    for my $i ( 1 .. length($target) ) {
+        # What character we are trying to match
+        my $c = substr( $target, $i - 1, 1 );
+
+        # See if any of the current solutions are still valid by
+        #  matching the character
+        @remaining = map { _remove_character( $c, $_ ) } @remaining;
+
+        # There are no possible solutions
+        return 0 if scalar(@remaining) == 0;
+    }
+
+    # We've reached the target!
+    return 1;
+}
+
+say main(@ARGV);