Add solutions to 287: Strong Password & Valid Number by E. Choroba

2 files changed, 116 insertions, 0 deletions

diff --git a/challenge-287/e-choroba/perl/ch-1.pl b/challenge-287/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..c79a966a13
--- /dev/null
+++ b/challenge-287/e-choroba/perl/ch-1.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+use List::Util qw{ first };
+
+# We can ignore deletion. We can always replace a character with a character
+# of the same class different to the previous and following one instead.
+sub strong_password($str) {
+    my %agenda = ($str => 0);
+
+    while (1) {
+        my %next;
+        for my $s (keys %agenda) {
+
+            if (6 > length $s) {
+                for my $char (qw( a A 0 )) {
+                    $next{ $s . (($char eq substr $str, -1)
+                                 ? chr(1 + ord $char)
+                                 : $char)
+                    } = 1 + $agenda{$s};
+                }
+            } elsif ($s !~ /[[:lower:]]/
+                     || $s !~ /[[:upper:]]/
+                     || $s !~ /[0-9]/
+                     || $s =~ /(.)\1\1/
+            ) {
+                for my $l (0 .. length($s) - 1) {
+
+                    my $this      = substr $s, $l, 1;
+                    my $previous  = $l > 0 ? substr $s, $l - 1, 1 : 'a';
+                    my $following = $l == length($s) - 1
+                                    ? 'a'
+                                    : substr $s, $l + 1, 1;
+
+                    # Try replacing every character with a lower-cased char,
+                    # upper-cased char, and a digit different to the char
+                    # itself, the preceding character, and the following
+                    # character.
+                    $next{ substr($s, 0, $l) . $_ . substr($s, $l + 1) }
+                        = 1 + $agenda{$s}
+                            for grep defined,
+                                map {
+                                    first { /[^$this$previous$following]/ }
+                                    @$_
+                                }
+                                [qw[ 0 1 2 ]], [qw[ a b c ]], [qw[ A B C ]];
+                }
+            } else {
+                return $agenda{$s}
+            }
+        }
+        %agenda = %next;
+    }
+}
+
+use Test::More tests => 5 + 3;
+
+is strong_password('a'), 5, 'Example 1';
+is strong_password('aB2'), 3, 'Example 2';
+is strong_password('PaaSW0rd'), 0, 'Example 3';
+is strong_password('Paaasw0rd'), 1, 'Example 4';
+is strong_password('aaaaa'), 2, 'Example 5';
+
+is strong_password('aaaZZZ999'), 3, 'Repeated triplets';
+is strong_password('0Zaaab'), 1, 'Creating a triple';
+is strong_password('000aaa000'), 3, 'Combined actions';
diff --git a/challenge-287/e-choroba/perl/ch-2.pl b/challenge-287/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..00581898d7
--- /dev/null
+++ b/challenge-287/e-choroba/perl/ch-2.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub valid_number($str) {
+    return $str =~ /^(?:([-+](?=.)) ?              # Leading sign.
+                       (?:0? | [1-9][0-9]*)        # Zero or non-zero integer.
+                       (?:(?<=[0-9])\.             # Final dot after something.
+                         | \.[0-9]+) ?             # Dot followed by digits.
+                       (?:(?<=[^+-])[eE]           # Exponent.
+                           (?:[-+](?=[1-9]))?      # Signed non-0.
+                           (0 | [1-9][0-9]*)) ?    # Zero on non-zero int.
+                    )$/x ? 1 : 0
+}
+
+use Test::More tests => 7 + 10;
+
+is valid_number('1'), 1, 'Example 1';
+is valid_number('a'), 0, 'Example 2';
+is valid_number('.'), 0, 'Example 3';
+is valid_number('1.2e4.2'), 0, 'Example 4';
+is valid_number('-1.'), 1, 'Example 5';
+is valid_number('+1E-8'), 1, 'Example 6';
+is valid_number('.44'), 1, 'Example 7';
+
+is valid_number('0'), 1, 'Zero';
+is valid_number('e1'), 0, 'e1';
+is valid_number('0.00'), 1, 'Zeros';
+is valid_number('-'), 0, 'sign without digits';
+is valid_number('-.'), 0, 'sign without digits';
+is valid_number('2.e-0'), 0, 'exponent -0';
+is valid_number('.e2'), 0, '.e';
+is valid_number('01'), 0, 'Leading 0';
+is valid_number('.1e03'), 0, 'Exponent leading 0';
+is valid_number('.1e+03'), 0, 'Exponent leading 0 signed';
+
+use Scalar::Util qw{ looks_like_number };
+for (1 .. 1_000_000) {
+    my $s = join "", map qw( 0 1 2 e E . + -)[rand 8], 0 .. rand 9;
+    print "random $s ", valid_number($s), "\n"
+        if !!valid_number($s) != looks_like_number($s)
+        # These are valid number for Perl, but not for us:
+        && looks_like_number($s)
+        && $s !~ /^[-+]?0[0-9]                # Leading 0.
+                  | [eE](?:[-+]0 | 0[0-9])    # e-0, e01 (but e0 is ok)
+                 /x;
+}