Skip to content

Commit 7096482

Browse files
committed
improve and explain wk-082 ch-2
1 parent dbdc30b commit 7096482

File tree

1 file changed

+69
-34
lines changed
  • challenge-082/alexander-pankoff/perl

1 file changed

+69
-34
lines changed

challenge-082/alexander-pankoff/perl/ch-2.pl

+69-34
Original file line numberDiff line numberDiff line change
@@ -9,51 +9,86 @@
99

1010
use Pod::Usage;
1111

12-
use List::Util qw(min all any);
12+
use List::Util qw(min all any pairs);
1313
use Scalar::Util qw(looks_like_number);
1414

15-
=pod
15+
pod2usage(
16+
-message => "$0: Need exactly three arguments",
17+
-exitval => 1,
18+
) if @ARGV != 3;
1619

17-
=head1 SYNOPSIS
20+
my ( $A, $B, $C ) = @ARGV;
1821

19-
Given three strings <A>, <B> and <C> this script will return whether <C> can be
20-
created by interleaving <A> and <B>
22+
say is_creatable_by_interleaving( $C, $A, $B ) ? 1 : 0;
2123

22-
=head1 USAGE
24+
sub is_creatable_by_interleaving ( $target, $a, $b ) {
2325

24-
ch-2.pl <A> <B> <C>
26+
# first check whether the total lenght of $a and $b match with the target
27+
# length
28+
return 0 if length($target) != length($a) + length($b);
2529

26-
=cut
30+
# we now check wether any of $a or $b starts with the same char as $target
31+
# if so, we recurse with the rest of $target and the matching item to
32+
# check the remaining input.
33+
# otherwise we can't find a way to interleave $a and $b to make $target
34+
#
35+
# to prevent checking the length condition above in every recursive case we
36+
# define a helper without that check. since we consume the input charwise
37+
# and pairwise, either from $target and $a or from $target and $b that
38+
# condition won't change
39+
my $go;
40+
$go = sub ( $target, $a, $b ) {
41+
# base case. we consumed all inputs - $target is $a and $b interleaved
42+
# since we already made sure that the total lengths match up we only
43+
# need to check wether $target became empty here.
44+
return 1 if !length($target);
2745

28-
pod2usage(
29-
-message => "$0: Need exactly three arguments",
30-
-exitval => 1,
31-
-verbose => 99,
32-
-sections => "USAGE|SYNOPSIS",
33-
) if @ARGV != 3;
46+
my $head = substr( $target, 0, 1 );
47+
my $rest = substr( $target, 1 );
3448

35-
my ( $A, $B, $C ) = @ARGV;
36-
say is_creatable_by_interleaving( $C, $A, $B );
49+
# the order of $a and $b in the recursice call doesn't matter
50+
# so we can just run the same routine on (a,b) and (b,a) instead of
51+
# using two routines with the arguments flipped
52+
return any(
53+
sub {
54+
starts_with( $_->[0], $head )
55+
&& $go->( $rest, substr( $_->[0], 1 ), $_->[1] );
56+
},
57+
pairs( $a, $b, $b, $a )
58+
);
3759

38-
sub is_creatable_by_interleaving ( $target, $a, $b ) {
39-
return 0 if length($target) != length($a) + length($b);
40-
return 1 if !length($target);
41-
42-
my $head = substr( $target, 0, 1 );
43-
my $rest = substr( $target, 1 );
44-
45-
return (
46-
starts_with( $head, $a )
47-
? is_creatable_by_interleaving( $rest, substr( $a, 1 ), $b )
48-
: 0
49-
)
50-
|| (
51-
starts_with( $head, $b )
52-
? is_creatable_by_interleaving( $rest, $a, substr( $b, 1 ) )
53-
: 0
54-
);
60+
};
61+
62+
$go->( $target, $a, $b );
5563
}
5664

57-
sub starts_with ( $char, $str ) {
65+
sub starts_with ( $str, $char ) {
5866
return $str =~ m/^$char/;
5967
}
68+
69+
=pod
70+
71+
=head1 NAME
72+
73+
wk-082 ch-2 - Interleave String
74+
75+
=head1 SYNOPSIS
76+
77+
Given three strings <A>, <B> and <C> this script prints whether <C> can be
78+
created by interleaving <A> and <B>
79+
80+
ch-2.pl <A> <B> <C>
81+
82+
=head1 ARGUMENTS
83+
84+
=over 8
85+
86+
=item B<A> The first input string
87+
88+
=item B<B> The first input string
89+
90+
=item B<C> The target string
91+
92+
=back
93+
94+
=cut

0 commit comments

Comments
 (0)