aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xchallenge-082/alexander-pankoff/perl/ch-1.pl67
-rwxr-xr-xchallenge-082/alexander-pankoff/perl/ch-2.pl94
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