diff options
| -rwxr-xr-x | challenge-082/alexander-pankoff/perl/ch-2.pl | 103 |
1 files changed, 69 insertions, 34 deletions
diff --git a/challenge-082/alexander-pankoff/perl/ch-2.pl b/challenge-082/alexander-pankoff/perl/ch-2.pl index a5c586d085..c8587624a5 100755 --- a/challenge-082/alexander-pankoff/perl/ch-2.pl +++ b/challenge-082/alexander-pankoff/perl/ch-2.pl @@ -9,51 +9,86 @@ no warnings 'experimental::signatures'; use Pod::Usage; -use List::Util qw(min all any); +use List::Util qw(min all any pairs); use Scalar::Util qw(looks_like_number); -=pod +pod2usage( + -message => "$0: Need exactly three arguments", + -exitval => 1, +) if @ARGV != 3; -=head1 SYNOPSIS +my ( $A, $B, $C ) = @ARGV; -Given three strings <A>, <B> and <C> this script will return whether <C> can be -created by interleaving <A> and <B> +say is_creatable_by_interleaving( $C, $A, $B ) ? 1 : 0; -=head1 USAGE +sub is_creatable_by_interleaving ( $target, $a, $b ) { -ch-2.pl <A> <B> <C> + # first check whether the total lenght of $a and $b match with the target + # length + return 0 if length($target) != length($a) + length($b); -=cut + # 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); -pod2usage( - -message => "$0: Need exactly three arguments", - -exitval => 1, - -verbose => 99, - -sections => "USAGE|SYNOPSIS", -) if @ARGV != 3; + my $head = substr( $target, 0, 1 ); + my $rest = substr( $target, 1 ); -my ( $A, $B, $C ) = @ARGV; -say is_creatable_by_interleaving( $C, $A, $B ); + # 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 ) + ); -sub is_creatable_by_interleaving ( $target, $a, $b ) { - return 0 if length($target) != length($a) + length($b); - return 1 if !length($target); - - my $head = substr( $target, 0, 1 ); - my $rest = substr( $target, 1 ); - - return ( - starts_with( $head, $a ) - ? is_creatable_by_interleaving( $rest, substr( $a, 1 ), $b ) - : 0 - ) - || ( - starts_with( $head, $b ) - ? is_creatable_by_interleaving( $rest, $a, substr( $b, 1 ) ) - : 0 - ); + }; + + $go->( $target, $a, $b ); } -sub starts_with ( $char, $str ) { +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 |