Merge pull request #7075 from Util/branch-for-challenge-190

Add TWC 190 solutions (Perl and Raku) by Bruce Gray.

4 files changed, 175 insertions, 0 deletions

diff --git a/challenge-190/bruce-gray/perl/ch-1.pl b/challenge-190/bruce-gray/perl/ch-1.pl
new file mode 100644
index 0000000000..9c7853c16f
--- /dev/null
+++ b/challenge-190/bruce-gray/perl/ch-1.pl
@@ -0,0 +1,23 @@
+use v5.36;
+
+sub task1 ( $s ) {
+    0+(    $s eq lc($s)
+        or $s eq uc($s)
+        or $s eq ucfirst lc($s)
+    )
+}
+
+
+my @tests = (
+    [ 'Perl'   , 1 ],
+    [ 'TPF'    , 1 ],
+    [ 'PyThon' , 0 ],
+    [ 'raku'   , 1 ],
+);
+use Test::More;
+plan tests => 0+@tests;
+for (@tests) {
+    my ( $input, $expected ) = @{$_};
+
+    is_deeply task1($input), $expected, "task1('$input')";
+}
diff --git a/challenge-190/bruce-gray/perl/ch-2.pl b/challenge-190/bruce-gray/perl/ch-2.pl
new file mode 100644
index 0000000000..894759d8b8
--- /dev/null
+++ b/challenge-190/bruce-gray/perl/ch-2.pl
@@ -0,0 +1,62 @@
+use v5.36;
+use List::Util qw<all mesh>;
+
+sub number_valid ($n) { $n >= 1 and $n <= 26 }
+
+sub all_numbers_valid ( $ns_aref ) {
+    return all { number_valid($_) } @{$ns_aref};
+}
+
+sub partition ($s) {
+    my @r;
+    for my $i ( 1 .. length($s) ) {
+        my ($prefix, $t) = unpack "a$i a*", $s;
+        last unless number_valid($prefix); # Speed optimization
+        push @r, map { [ $prefix, @{$_} ] } partition($t);
+    }
+    return !@r ? [] : grep { all_numbers_valid($_) } @r;
+}
+
+sub task2 ($s) {
+    state @letters = (undef, 'A'..'Z');
+    return [ sort map { join '', @letters[ @{$_} ] } partition($s) ];
+}
+
+
+
+my @tests1 = (
+    [   11, [qw< AA K                >] ],
+    [ 1115, [qw< AAAE AAO AKE KAE KO >] ],
+    [  127, [qw< ABG LG              >] ],
+
+    [  222, [qw< BBB BV VB           >] ],
+    [ 2222, [qw< BBBB BBV BVB VBB VV >] ],
+    [ 2333, [qw< BCCC WCC            >] ],
+    [ 2626, [qw< BFBF BFZ ZBF ZZ     >] ],
+    [ 2727, [qw< BGBG                >] ],
+);
+my @tests2 = split "\n", <<'END';
+I have got 
+such a rotten
+little present
+Misbegotten
+and unpleasant
+Learn your lesson
+Try to leave me
+off your list
+END
+use Test::More;
+plan tests => 0+@tests1+@tests2;
+for (@tests1) {
+    my ( $input, $expected ) = @{$_};
+    is_deeply task2($input), $expected, "task2($input)";
+}
+sub to_num ( $s ) {
+    state %alpha = mesh ['A'..'Z'], [1..26];
+    return join '', map { $alpha{$_} } split '', $s;
+}
+for my $text (@tests2) {
+    my $input = uc($text =~ tr/ ''//dr);
+    my $count = 0 + grep { $_ eq $input } @{ task2(to_num $input) };
+    is $count, 1, $text;
+}
diff --git a/challenge-190/bruce-gray/raku/ch-1.raku b/challenge-190/bruce-gray/raku/ch-1.raku
new file mode 100644
index 0000000000..f4067e6109
--- /dev/null
+++ b/challenge-190/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,13 @@
+sub task1 ( Str $_ --> Bool ) { so $_ eq (.lc | .uc | .tclc) }
+
+my @tests =
+    ( 'Perl'   , 1 ),
+    ( 'TPF'    , 1 ),
+    ( 'PyThon' , 0 ),
+    ( 'raku'   , 1 ),
+;
+use Test;
+plan +@tests;
+for @tests -> ( $input, $expected ) {
+    is-deeply +task1($input), $expected, "task1('$input')";
+}
diff --git a/challenge-190/bruce-gray/raku/ch-2.raku b/challenge-190/bruce-gray/raku/ch-2.raku
new file mode 100644
index 0000000000..be3b44c9ae
--- /dev/null
+++ b/challenge-190/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,77 @@
+sub digit_partitions ( UInt $n ) {
+    # constant $re = / ^   (.)+ $ /;        # Works.
+    # constant $re = / ^ (\d+)+ $ /;        # Faster?
+    # constant $re = / ^ (\d ** 1..2)+ $ /; # Faster!
+
+    # Fastest! either of these have the same speed, but have different semantics in other contexts.
+    # constant $re = / ^ (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16|17|18|19|20|21|22|23|24|25|26)+ $ /;
+    constant $re = / ^ (1||2||3||4||5||6||7||8||9||10||11||12||13||14||15||16||17||18||19||20||21||22||23||24||25||26)+ $ /;
+
+    # This fails! But doesn't this doc say it should work?: https://docs.raku.org/language/regexes#Quoted_lists_are_LTM_matches
+    # constant @nums = 1 .. 26;
+    # constant $re = / ^ (@nums)+ $ /;
+
+    return $n.match( :ex, $re ).map({ .[0].map(~*) });
+    # 1. .match(:ex) emits a list of Match objects,
+    #    each of which is one of the many ways the RE could match the target.
+    # 2. .map processes that list; inside the map $_ is a single Match object.
+    # 3. That Match contains, via its .list "view",
+    #    a Array of all the parenthsised captures,
+    #    .[0] being the first set of lexical parens.
+    # 4. `.[0]` accesses the first-and-only set of parens: (\d+)
+    # 5. There was a `+` after that set of parens,
+    #    so this next level is also an Array of Match objects,
+    #    each of which is a cluster of one-or-more digits.
+    #    We need each of those to be Numeric instead of Match.
+    # 6. `.map` walks that innermost Array,
+    #    stringifying the Match in $_ via `~`
+}
+
+sub task2 ( Str(Cool) $s ) {
+    constant %letters = 1 .. 26 Z=> 'A' .. 'Z';
+
+    my sub joined_letters_if_all_are_valid (@ns) {
+        .join if .all.so given %letters{ @ns };
+    }
+
+    return sort digit_partitions(+$s).map: &joined_letters_if_all_are_valid;
+}
+
+multi sub MAIN ( $input ) { say task2($input) }
+multi sub MAIN ( Bool :$test ) {
+    my @tests1 =
+        (   11, <AA K> ),
+        ( 1115, <AAAE AAO AKE KAE KO> ),
+        (  127, <ABG LG> ),
+
+        (   222, <BBB BV VB> ),
+        (  2222, <BBBB BBV BVB VBB VV> ),
+        (  2333, <BCCC WCC> ),
+        (  2626, <BFBF BFZ ZBF ZZ> ),
+        (  2727, ('BGBG',) ),
+    ;
+    my @tests2 = q:to/END/.lines;
+        I have got 
+        such a rotten
+        little present
+        Misbegotten
+        and unpleasant
+        Learn your lesson
+        Try to leave me
+        off your list
+        END
+    use Test;
+    plan +@tests1+@tests2;
+    for @tests1 -> ( $input, @expected ) {
+        is-deeply task2($input), @expected, "task2($input)";
+    }
+    sub to_num ( $s ) {
+        constant %alpha = 'A'..'Z' Z=> 1..26;
+        return %alpha{ $s.comb }.join;
+    }
+    for @tests2 -> $lyric {
+        my $input = $lyric.uc.trans( ' ' => '', "'" => '' );
+        my $count = +grep * eq $input, task2(to_num $input);
+        is $count, 1, $lyric;
+    }
+}