Add Peter Pentchev's Raku solutions to 287

6 files changed, 299 insertions, 0 deletions

diff --git a/challenge-287/ppentchev/docs/index.md b/challenge-287/ppentchev/docs/index.md
index ff6dd94112..ec92fdf7d2 100644
--- a/challenge-287/ppentchev/docs/index.md
+++ b/challenge-287/ppentchev/docs/index.md
@@ -261,6 +261,16 @@ directly as three scalar variables instead of any kind of structured data.
 Of course it would be possible to stash them into a hash or a simple object, but
 this way was a bit simpler.
 
+#### Raku
+
+The Raku solution is quite similar to the Perl one, but it encapsulates the number of
+actions taken and the current state of the password string into a `Strength` class.
+It also encapsulates the state of the parser used to find too-long runs of the same
+character into a `RunState` class.
+
+The `fix_runs()`, `fix_length()`, and `fix_missing()` functions are translated into
+the `fix-runs()`, `fix-length()`, and `fix-missing()` methods of the `Strength` class.
+
 ### Task 2: Valid Number
 
 #### Perl
@@ -273,6 +283,16 @@ The Perl solution has three major elements:
   depending on whether the argument represents a valid number
 - `parse_stdin` - read a line from the standard input, return it as a string to be examined
 
+#### Raku
+
+In the Raku solution we chose the other way: write a simple grammar (`ValidNumber`) that
+will recognize a number as defined in the problem.
+The grammar is so simple that it does not even need to define any actions; returning
+a non-empty, defined result is enough to determine whether the input was recognized.
+
+Well, okay, since Raku grammars are actually regular expressions in disguise, one might
+argue that we did not go so far the other way then :)
+
 ## Contact
 
 These solutions were written by [Peter Pentchev][roam].
diff --git a/challenge-287/ppentchev/raku/scripts/ch-1.raku b/challenge-287/ppentchev/raku/scripts/ch-1.raku
new file mode 100755
index 0000000000..38336f8a8a
--- /dev/null
+++ b/challenge-287/ppentchev/raku/scripts/ch-1.raku
@@ -0,0 +1,145 @@
+#!/usr/bin/raku
+# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
+# SPDX-License-Identifier: BSD-2-Clause
+
+my Int:D constant $DESIRED_LENGTH = 6;
+my Bool:D constant $PWC_QUIET = (%*ENV{'PWC_QUIET'} // '') eq '1';
+my Bool:D constant $PWC_USE_LOCALE = (%*ENV{'PWC_USE_LOCALE'} // '') eq '1';
+
+my Str:D @TEST_STRINGS = 'a', 'aB2', 'PassW0rd', 'PaaaSW0rd', 'aaaaa';
+
+sub diag(Str:D $msg)
+{
+	$msg.note unless $PWC_QUIET;
+}
+
+class Strength
+{
+	has Int:D $.actions is required is readonly;
+	has Int:D $.length is required is readonly;
+	has Int:D $.missing is required is readonly;
+	has Int:D @.runs is required is readonly;
+
+	method fix-runs() returns Strength:D
+	{
+		my $taken = (@.runs.map: (* / 3).Int).sum;
+		my $missing = $.missing >= $taken ?? $.missing - $taken !! 0;
+		Strength.new(:actions($.actions + $taken), :$.length, :$missing, :runs())
+	}
+
+	method fix-length() returns Strength:D
+	{
+		my $taken = $.length < $DESIRED_LENGTH ?? $DESIRED_LENGTH - $.length !! 0;
+		my $missing = $.missing >= $taken ?? $.missing - $taken !! 0;
+		Strength.new(:actions($.actions + $taken), :length($.length + $taken), :$missing, :@.runs)
+	}
+
+	method fix-missing() returns Strength:D
+	{
+		my $taken = $.missing > 0 ?? $.missing !! 0;
+		Strength.new(:actions($.actions + $taken), :$.length, :missing(0), :@.runs)
+	}
+}
+
+sub diag-strength(Str:D $tag, Strength:D $strength)
+{
+	diag "strength at $tag: "
+		~ "actions " ~ $strength.actions
+		~ ", length " ~ $strength.length
+		~ ", missing " ~ $strength.missing
+		~ ", runs " ~ $strength.runs.raku
+		unless $PWC_QUIET;
+}
+
+class RunState
+{
+	has Int:D @.runs is required is readonly;
+	has Str:D $.last is required is readonly;
+	has Int:D $.count is required is readonly;
+
+	method update(Str:D $char) returns RunState
+	{
+		if $char eq $.last {
+			RunState.new(:@.runs, :$.last, :count($.count + 1))
+		} elsif $.count >= 3 {
+			RunState.new(:runs(|@.runs, $.count), :last($char), :count(1))
+		} else {
+			RunState.new(:@.runs, :last($char), :count(1))
+		}
+	}
+
+	method update-finish() returns RunState
+	{
+		if $.count >= 3 {
+			RunState.new(:runs(|@.runs, $.count), :last(' '), :count(0))
+		} else {
+			self
+		}
+	}
+}
+
+enum CharClass
+(
+	ChLower => 'lower',
+	ChUpper => 'upper',
+	ChDigit => 'digit',
+);
+
+sub classify(Str:D $char) returns CharClass
+{
+	if $PWC_USE_LOCALE {
+        	given $char {
+        		when / <lower> / { ChLower }
+        		when / <upper> / { ChUpper }
+        		when / <digit> / { ChDigit }
+        		default { Nil }
+        	}
+	} else {
+        	given $char {
+        		when / <[a .. z]> / { ChLower }
+        		when / <[A .. Z]> / { ChUpper }
+        		when / <[0 .. 9]> / { ChDigit }
+        		default { Nil }
+        	}
+	}
+}
+
+sub examine-password(Str:D $password) returns Strength:D
+{
+	my $length = $password.chars;
+	my $run_init_state = RunState.new(:runs(), :last(' '), :count(0));
+	my @chars = $password.split('', :skip-empty);
+	my @runs = (
+		reduce { $^state.update($^value) }, $run_init_state, |@chars
+	).update-finish.runs;
+	my $missing = 3 - @chars.map(&classify).grep(*.defined).Set.elems;
+	Strength.new(:actions(0), :$length, :$missing, :@runs)
+}
+
+sub strong-password(Str:D $password) returns Int:D
+{
+	my $st_init = examine-password $password;
+	diag-strength 'init', $st_init;
+
+	my $st_runs = $st_init.fix-runs;
+	diag-strength 'runs', $st_runs;
+
+	my $st_length = $st_runs.fix-length;
+	diag-strength 'length', $st_length;
+
+	my $st_missing = $st_length.fix-missing;
+	diag-strength 'missing', $st_missing;
+
+	$st_missing.actions
+}
+
+{
+	if (%*ENV{'PWC_FROM_STDIN'} // '') eq '1' {
+		my $line = $*IN.get;
+		say strong-password $line;
+	} else {
+        	for @TEST_STRINGS {
+        		say strong-password $^password;
+        	}
+	}
+}
diff --git a/challenge-287/ppentchev/raku/scripts/ch-2.raku b/challenge-287/ppentchev/raku/scripts/ch-2.raku
new file mode 100755
index 0000000000..b97869d3f3
--- /dev/null
+++ b/challenge-287/ppentchev/raku/scripts/ch-2.raku
@@ -0,0 +1,37 @@
+#!/usr/bin/raku
+# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
+# SPDX-License-Identifier: BSD-2-Clause
+
+my Str:D @TEST_NUMBERS = '1', 'a', '.', '1.2e4.2', '-1.', '+1E-8', '.44';
+
+grammar ValidNumber
+{
+	token TOP { <mantissa> <exponent>? };
+
+	token mantissa { <large-number> | <small-number> };
+	token exponent { <[Ee]> <int-sign>? <int-digit>+ }
+
+	token large-number { <int-sign>? <int-digit>+ <large-fractional-part>? };
+	token large-fractional-part { <[.]> <int-digit>* }
+	token small-number { <[.]> <int-digit>+ }
+
+	token int-sign { <[+-]> };
+	token int-digit { <[0 .. 9]> };
+}
+
+sub valid-number(Str:D $str) returns Str:D
+{
+	my $parsed = try ValidNumber.parse($str);
+	!$! && $parsed.defined ?? 'true' !! 'false'
+}
+
+{
+	if (%*ENV{'PWC_FROM_STDIN'} // '') eq '1' {
+		my $line = $*IN.get;
+		say valid-number $line;
+	} else {
+        	for @TEST_NUMBERS {
+        		say valid-number $^str;
+        	}
+	}
+}
diff --git a/challenge-287/ppentchev/tests/03-raku-ch-1.t b/challenge-287/ppentchev/tests/03-raku-ch-1.t
new file mode 100644
index 0000000000..f872ba899c
--- /dev/null
+++ b/challenge-287/ppentchev/tests/03-raku-ch-1.t
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
+# SPDX-License-Identifier: BSD-2-Clause
+
+use v5.16;
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib 'tests/lib';
+
+use PWCTest::Ch287 qw(find_raku test_strong_password test_strong_password_count test_strong_password_default);
+
+use constant PROG => 'raku/scripts/ch-1.raku';
+
+my $raku;
+BEGIN {
+    $raku = find_raku;
+}
+
+if (!defined $raku) {
+    plan skip_all => 'no Raku interpreter found';
+    exit 0;
+}
+
+plan tests => 2;
+
+my $raku_prog = [$raku, '--', PROG];
+
+subtest strong_password_default => sub {
+	test_strong_password_default $raku_prog;
+};
+
+subtest strong_password => sub {
+    plan tests => test_strong_password_count;
+    for my $idx (1..test_strong_password_count) {
+        subtest "run $idx" => sub {
+            test_strong_password $raku_prog, $idx - 1;
+        };
+    }
+};
diff --git a/challenge-287/ppentchev/tests/04-raku-ch-2.t b/challenge-287/ppentchev/tests/04-raku-ch-2.t
new file mode 100644
index 0000000000..ba3d393def
--- /dev/null
+++ b/challenge-287/ppentchev/tests/04-raku-ch-2.t
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
+# SPDX-License-Identifier: BSD-2-Clause
+
+use v5.16;
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib 'tests/lib';
+
+use PWCTest::Ch287 qw(
+	find_raku
+	test_valid_number
+	test_valid_number_count
+	test_valid_number_default
+);
+
+my $raku;
+BEGIN {
+	$raku = find_raku;
+}
+
+if (!defined $raku) {
+	plan skip_all => 'no Raku interpreter found';
+	exit 0;
+}
+
+plan tests => 2;
+
+use constant PROG => 'raku/scripts/ch-2.raku';
+
+my $raku_prog = [$raku, '--', PROG];
+
+subtest valid_number_default => sub {
+	test_valid_number_default $raku_prog;
+};
+
+subtest valid_number => sub {
+    plan tests => test_valid_number_count;
+    for my $idx (1..test_valid_number_count) {
+        subtest "run $idx" => sub {
+            test_valid_number $raku_prog, $idx - 1;
+        };
+    }
+};
diff --git a/challenge-287/ppentchev/tests/lib/PWCTest/Ch287.pm b/challenge-287/ppentchev/tests/lib/PWCTest/Ch287.pm
index 0b27145904..e0c6d2d791 100644
--- a/challenge-287/ppentchev/tests/lib/PWCTest/Ch287.pm
+++ b/challenge-287/ppentchev/tests/lib/PWCTest/Ch287.pm
@@ -19,6 +19,7 @@ use Test::Command qw();
 use Test::More;
 
 our @EXPORT_OK = qw(
+	find_raku
 	test_strong_password
 	test_strong_password_count
 	test_strong_password_default
@@ -140,4 +141,11 @@ sub test_valid_number($ $) {
 	test_run_program $cmd, $str, $expected;
 }
 
+sub find_raku()
+{
+	my $prog = $ENV{RAKU} || 'raku';
+	my $res = system { $prog } ($prog, '-e', 'use strict');
+	(defined $res && $res == 0) ? $prog : undef
+}
+
 1;