Merge pull request #2520 from ccntrq/challenge-082

Challenge 082

2 files changed, 161 insertions, 0 deletions

diff --git a/challenge-082/alexander-pankoff/perl/ch-1.pl b/challenge-082/alexander-pankoff/perl/ch-1.pl
new file mode 100755
index 0000000000..1b9916d7b5
--- /dev/null
+++ b/challenge-082/alexander-pankoff/perl/ch-1.pl
@@ -0,0 +1,67 @@
+#!/usr/bin/env perl
+use v5.20;
+use utf8;
+use strict;
+use warnings;
+use autodie;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+use Pod::Usage;
+
+use List::Util qw(min all any);
+use Scalar::Util qw(looks_like_number);
+
+pod2usage(
+    -message => "$0: Expects 2 natural numbers",
+    -exitval => 1,
+  )
+  if @ARGV != 2
+  or any { !looks_like_number($_) || $_ < 1 } @ARGV;
+
+my ( $M, $N ) = @ARGV;
+
+say format_list( common_factors( $M, $N ) );
+
+sub common_factors ( $m, $n ) {
+
+    # we grep for numbers from 1 to min($m,$n) that are factors of both $m and
+    # $n. since all numbers larger than min($m,$n) can't be a factor of that
+    # minimum we don't have to check them
+    grep {
+        my $check_factor = $_;
+        all { is_factor( $check_factor, $_ ) } ( $m, $n );
+    } 1 .. min( $m, $n );
+}
+
+sub is_factor ( $divisor, $value ) {
+    return $value % $divisor == 0;
+}
+
+sub format_list(@list) {
+    return '(' . join( ', ', @list ) . ')';
+}
+
+=pod
+
+=head1 NAME
+
+wk-082 ch-1 - Common Factors
+
+=head1 SYNOPSIS
+
+Prints the common factors of two given natural numbers M and N
+
+ch-1.pl <M> <N>
+
+=head1 ARGUMENTS
+
+=over 8
+
+=item B<N> The first natural number
+
+=item B<M> The second natural number
+
+=back
+
+=cut
diff --git a/challenge-082/alexander-pankoff/perl/ch-2.pl b/challenge-082/alexander-pankoff/perl/ch-2.pl
new file mode 100755
index 0000000000..c8587624a5
--- /dev/null
+++ b/challenge-082/alexander-pankoff/perl/ch-2.pl
@@ -0,0 +1,94 @@
+#!/usr/bin/env perl
+use v5.20;
+use utf8;
+use strict;
+use warnings;
+use autodie;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+use Pod::Usage;
+
+use List::Util qw(min all any pairs);
+use Scalar::Util qw(looks_like_number);
+
+pod2usage(
+    -message => "$0: Need exactly three arguments",
+    -exitval => 1,
+) if @ARGV != 3;
+
+my ( $A, $B, $C ) = @ARGV;
+
+say is_creatable_by_interleaving( $C, $A, $B ) ? 1 : 0;
+
+sub is_creatable_by_interleaving ( $target, $a, $b ) {
+
+    # first check whether the total lenght of $a and $b match with the target
+    # length
+    return 0 if length($target) != length($a) + length($b);
+
+    # we now check wether any of $a or $b starts with the same char as $target
+    # if so, we recurse with the rest of $target and the matching item to
+    # check the remaining input.
+    # otherwise we can't find a way to interleave $a and $b to make $target
+    #
+    # to prevent checking the length condition above in every recursive case we
+    # define a helper without that check. since we consume the input charwise
+    # and pairwise, either from $target and $a or from $target and $b that
+    # condition won't change
+    my $go;
+    $go = sub ( $target, $a, $b ) {
+        # base case. we consumed all inputs - $target is $a and $b interleaved
+        # since we already made sure that the total lengths match up we only
+        # need to check wether $target became empty here.
+        return 1 if !length($target);
+
+        my $head = substr( $target, 0, 1 );
+        my $rest = substr( $target, 1 );
+
+        # the order of $a and $b in the recursice call doesn't matter
+        # so we can just run the same routine on (a,b) and (b,a) instead of
+        # using two routines with the arguments flipped
+        return any(
+            sub {
+                starts_with( $_->[0], $head )
+                  && $go->( $rest, substr( $_->[0], 1 ), $_->[1] );
+            },
+            pairs( $a, $b, $b, $a )
+        );
+
+    };
+
+    $go->( $target, $a, $b );
+}
+
+sub starts_with ( $str, $char ) {
+    return $str =~ m/^$char/;
+}
+
+=pod
+
+=head1 NAME
+
+wk-082 ch-2 - Interleave String
+
+=head1 SYNOPSIS
+
+Given three strings <A>, <B> and <C> this script prints whether <C> can be
+created by interleaving <A> and <B>
+
+ch-2.pl <A> <B> <C>
+
+=head1 ARGUMENTS
+
+=over 8
+
+=item B<A> The first input string
+
+=item B<B> The first input string
+
+=item B<C> The target string
+
+=back
+
+=cut