Merge pull request #10328 from jacoby/master

DAJ 275

2 files changed, 102 insertions, 0 deletions

diff --git a/challenge-275/dave-jacoby/perl/ch-1.pl b/challenge-275/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..0cf8c33f4d
--- /dev/null
+++ b/challenge-275/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ bitwise fc postderef say signatures state };
+
+use List::Util qw{max};
+
+my @examples = (
+
+    {
+        sentence => "Perl Weekly Challenge",
+        keys     => [ 'l', 'a' ]
+    },
+    {
+        sentence => "Perl and Raku",
+        keys     => ['a']
+    },
+    {
+        sentence => "Well done Team PWC",
+        keys     => [ 'l', 'o' ]
+    },
+    {
+        sentence => "The joys of polyglottism",
+        keys     => ['T']
+    },
+);
+
+for my $example (@examples) {
+    my $output   = broken_keys($example);
+    my $sentence = $example->{sentence};
+    my $keys     = join ',', map { qq{'$_'} } $example->{keys}->@*;
+
+    say <<~"END";
+        Input:  \$sentence = "$sentence", \@keys = ($keys)
+        Output: $output
+END
+}
+
+sub broken_keys ($obj) {
+    my $output   = 0;
+    my $sentence = $obj->{sentence};
+    my @sentence = split /\W+/, $sentence;
+    my @keys     = $obj->{keys}->@*;
+OUTER: for my $word (@sentence) {
+        for my $key (@keys) {
+            next OUTER if $word =~ /$key/mix;
+        }
+        $output++;
+    }
+    return $output;
+}
diff --git a/challenge-275/dave-jacoby/perl/ch-2.pl b/challenge-275/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..75e61056f8
--- /dev/null
+++ b/challenge-275/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ fc say postderef signatures state };
+
+use List::Util qw{ first };
+
+my @examples = (
+
+    'a1c1e1',
+    'a1b2c3d4',
+    'b2b',
+    'a16z',
+);
+
+for my $input (@examples) {
+    my $output = replace_digits($input);
+
+    say <<"END";
+        Input:  '$input'
+        Output: '$output'
+END
+}
+
+sub replace_digits ($string) {
+    state @digits   = ( 0 .. 9 );
+    state @alphabet = ( 'a' .. 'z', 'a' .. 'z' );
+    my $input = $string;
+    for my $i ( 0 .. -1 + length $string ) {
+        my $l = substr( $string, $i, 1 );
+        if ( grep { /$l/ } @digits ) {
+            my $p = get_previous_letter( $input, $i );
+            my $n = first { $alphabet[$_] eq $p } 0 .. scalar @alphabet;
+            my $m = $alphabet[ $l + $n ];
+            substr( $string, $i, 1 ) = $m;
+        }
+    }
+    return $string;
+}
+
+sub get_previous_letter ( $input, $index ) {
+    state @digits = ( 0 .. 9 );
+    while (1) {
+        $index -= 1;
+        my $l = substr( $input, $index, 1 );
+        return $l unless grep { /$l/ } @digits;
+    }
+    die 'found no string';
+}