Merge pull request #8885 from jacoby/master

DAJ 239

2 files changed, 77 insertions, 0 deletions

diff --git a/challenge-239/dave-jacoby/perl/ch-1.pl b/challenge-239/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..7dd89072c2
--- /dev/null
+++ b/challenge-239/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = (
+
+    [ [ "ab", "c" ], [ "a",  "bc" ] ],
+    [ [ "ab", "c" ], [ "ac", "b" ] ],
+    [ [ "ab", "cd", "e" ], ["abcde"] ],
+);
+
+for my $e (@examples) {
+    my $output = same_string( $e->@* );
+    my $arr1 = join ', ', map { qq{"$_"} } $e->[0]->@*;
+    my $arr2 = join ', ', map { qq{"$_"} } $e->[1]->@*;
+    say <<~"END";
+    Input:  \@arr1 = ($arr1)
+            \@arr2 = ($arr2)
+    Output: $output
+    END
+}
+
+sub same_string ( @array ) {
+    my ( $s1, $s2 ) = map { join '', $_->@* } @array;
+    return $s1 eq $s2 ? 'true' : 'false';
+}
diff --git a/challenge-239/dave-jacoby/perl/ch-2.pl b/challenge-239/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..c9d40dd66b
--- /dev/null
+++ b/challenge-239/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Util qw{ uniq };
+
+my @examples = (
+
+    {
+        str     => [ "ad", "bd", "aaab", "baa", "badab" ],
+        allowed => "ab"
+    },
+    {
+        str     => [ "a", "b", "c", "ab", "ac", "bc", "abc" ],
+        allowed => "abc"
+    },
+    {
+        str     => [ "cc", "acd", "b", "ba", "bac", "bad", "ac", "d" ],
+        allowed => "cad"
+    },
+);
+
+for my $e (@examples) {
+    my $output  = consistent_strings($e);
+    my $str     = join ', ', map { qq{"$_"} } $e->{str}->@*;
+my $allowed = $e->{allowed};
+    say <<~"END";
+    Input:  \@str = ($str)
+            \$allowed = "$allowed"
+    Output: $output
+    END
+}
+
+sub consistent_strings ($input) {
+    my @allowed = split //, $input->{allowed};
+    my %allowed = map { $_ => 1 } @allowed;
+    my $n       = 0;
+OUTER: for my $str ( $input->{str}->@* ) {
+        my @chars = uniq sort split //, $str;
+        for my $c (@chars) {
+            next OUTER if !$allowed{$c};
+        }
+        $n++;
+    }
+    return $n;
+}
+