Merge pull request #8062 from choroba/ech216

Solve 216: Registration Number & Word Stickers by E. Choroba

2 files changed, 86 insertions, 0 deletions

diff --git a/challenge-216/e-choroba/perl/ch-1.pl b/challenge-216/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..482872b3db
--- /dev/null
+++ b/challenge-216/e-choroba/perl/ch-1.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub registration_number($reg, @words) {
+    my %required;
+    @required{ map lc, $reg =~ /[a-z]/gi } = ();
+    my @matches;
+
+    for my $word (@words) {
+        my %r = %required;
+        delete @r{ split //, $word };
+        next if keys %r;
+
+        push @matches, $word;
+    }
+    return \@matches
+}
+
+use Test2::V0;
+plan 3;
+
+is registration_number('AB1 2CD', 'abc', 'abcd', 'bcd'), ['abcd'],
+    'Example 1';
+is registration_number('007 JB', 'job', 'james', 'bjorg'), ['job', 'bjorg'],
+    'Example 2';
+is registration_number('C7 RA2', 'crack', 'road', 'rac'), ['crack', 'rac'],
+    'Example 3';
diff --git a/challenge-216/e-choroba/perl/ch-2.pl b/challenge-216/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..4b6d596d85
--- /dev/null
+++ b/challenge-216/e-choroba/perl/ch-2.pl
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+use List::Util qw{ min };
+
+sub word_stickers($word, @stickers) {
+    my $chars = join "", @stickers;
+    return 0 if $word =~ /[^$chars]/;
+
+    return word_stickers_($word, \@stickers)
+}
+
+sub word_stickers_($word, $stickers, @partial) {
+    return scalar @partial if "" eq $word;
+
+    my @counts;
+
+    for my $length (1 .. length $word) {
+        my $part = substr $word, 0, $length;
+        my @usables = grep -1 != index($partial[$_], $part), 0 .. $#partial;
+        for my $partial_idx (@usables) {
+            my $usable = $partial[$partial_idx];
+            my $from = index $usable, $part;
+            push @counts, word_stickers_(
+                substr($word, $length),
+                $stickers,
+                @partial[grep $_ != $partial_idx, 0 .. $#partial],
+                $usable =~ s/$part//r
+            );
+        }
+
+        for my $sticker (@$stickers) {
+            if (-1 != index $sticker, $part) {
+                push @counts, word_stickers_(substr($word, $length),
+                                             $stickers,
+                                             @partial,
+                                             $sticker =~ s/$part//r);
+            }
+        }
+    }
+    return min(@counts)
+}
+
+# Speed up: 2.5s -> 1s.
+use Memoize qw{ memoize };
+memoize('word_stickers_');
+
+
+use Test::More tests => 4 + 1;
+is word_stickers(peon => qw( perl raku python )), 2, 'Example 1';
+is word_stickers(goat => qw( love hate angry )), 3, 'Example 2';
+is word_stickers(accommodation => qw( come nation delta )), 4, 'Example 3';
+is word_stickers(accommodation => qw( come country delta )), 0, 'Example 4';
+
+is word_stickers(aabbbccc => qw( ab bc )), 5, 'a- ab -b bc c c';