Merge pull request #12377 from 0rir/work

330

3 files changed, 139 insertions, 1 deletions

diff --git a/challenge-329/0rir/raku/ch-2.raku b/challenge-329/0rir/raku/ch-2.raku
index 68940e6f47..3c1c52c95e 100644
--- a/challenge-329/0rir/raku/ch-2.raku
+++ b/challenge-329/0rir/raku/ch-2.raku
@@ -29,6 +29,7 @@ my @Test =
     "cC",       "cC",
     "A",        "",
     "",         "",
+    "AIaHAiaGAIahAiaFAIaHAiagAIahAiaEAIaHAiaGAIahAiafAIaHAiagAIahAiaDAIaHAiaGAIahAiaFAIaHAiagAIahAiaeAIaHAiaGAIahAiafAIaHAiagAIahAiaCAIaHAiaGAIahAiaFAIaHAiagAIahAiaEAIaHAiaGAIahAiafAIaHAiagAIahAiadAIaHAiaGAIahAiaFAIaHAiagAIahAiaeAIaHAiaGAIahAiafAIaHAiagAIahAiabAIaHAiaGAIahAiaFAIaHAiagAIahAiaEAIaHAiaGAIahAiafAIaHAiagAIahAiaDAIaHAiaGAIahAiaFAIaHAiagAIahAiaeAIaHAiaGAIahAiafAIaHAiagAIahAiacAIaHAiaGAIahAiaFAIaHAiagAIahAiaEAIaHAiaGAIahAiafAIaHAiagAIahAiadAIaHAiaGAIahAiaFAIaHAiagAIahAiaeAIaHAiaGAIahAiafAIaHAiagAIahAia", "",
 ;
 plan 2 +@Test ÷ 2;
 
@@ -44,7 +45,7 @@ sub oc( Str:D $char --> Str:D) {
     $char eq $char.uc ?? $char.lc !! $char.uc
 }
 
-
+#### XXX task solves a different problem! XXX
 # Is it an empty Str or an empty Str of Letters?
 #multi task( '') { die 'empty string' }
 
diff --git a/challenge-330/0rir/raku/ch-1.raku b/challenge-330/0rir/raku/ch-1.raku
new file mode 100644
index 0000000000..2288106c71
--- /dev/null
+++ b/challenge-330/0rir/raku/ch-1.raku
@@ -0,0 +1,99 @@
+#!/usr/bin/env raku
+# :vim ft=raku sw=4 expandtab  # 🦋 ∅∪∩∋∈∉⊆ ≡ ≢ «␤ » ∴
+use v6.d;
+use Test;
+
+=begin comment
+330-1: Clear Digits         Submitted by: Mohammad Sajid Anwar
+You are given a string containing only lower case English letters and digits.
+
+Write a script to remove all digits by removing the first digit and the closest non-digit character to its left.
+
+
+Example 1
+Input: $str = "cab12"
+Output: "c"
+
+Round 1: remove "1" then "b" => "ca2"
+Round 2: remove "2" then "a" => "c"
+
+Example 2
+Input: $str = "xy99"
+Output: ""
+
+Round 1: remove "9" then "y" => "x9"
+Round 2: remove "9" then "x" => ""
+
+Example 3
+Input: $str = "pa1erl"
+Output: "perl"
+=end comment
+
+my @Test =
+    "",                                     "",
+    "pa1erl",                               "perl",
+    "ca11b",                                "b",
+    'a',                                    'a',
+    "cab12",                                "c",
+    "cab12cd12",                            "c",
+    "xy99",                                 "",
+    "abc123abc123",                         "",
+    "a1a1ab12ab12abc123abc123",             "",
+    "a1xa1ab12ab12xabc123xabc123",          "xxx",
+    'a' x 100 ~ 'b1',                       'a' x 100,
+    "cab12" x 100,                          "c" x 100,
+    '1b',                                   '1b',
+    '1111111111',                           '1111111111',
+;
+
+=begin spec
+    It is not clear whether a un-paired digit should be deleted.
+=end spec
+
+plan +@Test ÷ 2;
+
+constant \OoB = '.';            #  an out of band value
+my \Nd = regex { ^ <:Nd> $ }
+my \L  = regex { ^ <:L>  $ }
+my @removee;                    # deletable chars by key
+
+# Return the index of a digit's partner or an Int type object.
+sub partner( @a, Int $idx --> Int){
+    quietly @a[0...$idx].first( :end, :k, * ~~ L)       # undef
+}
+
+# Return index of the next digit or an Int type object.
+sub seekn( @a, Int $head --> Int) {
+    my $ret = quietly @a[$head…@a.end].first: :k, * ~~ Nd;      # undefines
+    $ret.defined ?? $ret + $head !! Int;
+}
+
+multi task( "" --> "") {}
+multi task( Str:D $s where * ~~ /^L+ $/ , Bool :$req --> Str) { $s }
+multi task( Str:D $s where * ~~ /^Nd+ $/, Bool :$req -->Str ) {
+    $req ?? '' !! $s
+}
+multi task( Str:D $s --> Str ) {
+    my @a = $s.comb;
+    my $i = -1;
+    while $i < @a {
+        ++$i;
+        my $idx-n = seekn( @a, $i );
+        last unless $idx-n.defined;
+        my $idx-l = partner( @a, $idx-n);
+        if $idx-l.defined {
+            @a[$idx-l, $idx-n] = OoB xx 2;
+        }
+        $i = $idx-n;
+    }
+    (@a.=grep: * !~~ OoB).join;
+}
+
+for @Test -> $in, $exp {
+    is task( $in), $exp,                     "{$exp // $exp.^name()} <- $in.raku()";
+    #    is task( $in, :req), $exp-req, "{$exp-req // $exp-req.^name()} <- $in.raku()";
+}
+done-testing;
+my $str = "1axy9999";
+
+say qq{Input: \$str = "$str"\nOutput: "}, task($str), '"';
diff --git a/challenge-330/0rir/raku/ch-2.raku b/challenge-330/0rir/raku/ch-2.raku
new file mode 100644
index 0000000000..01d51f69e2
--- /dev/null
+++ b/challenge-330/0rir/raku/ch-2.raku
@@ -0,0 +1,38 @@
+#!/usr/bin/env raku
+# :vim ft=raku sw=4 expandtab  # 🦋 ∅∪∩∋∈∉⊆ ≡ ≢ «␤ » ∴
+use v6.d;
+INIT $*RAT-OVERFLOW = FatRat;
+use lib $?FILE.IO.cleanup.parent(2).add("lib");
+use Test;
+
+=begin comment
+330-
+You are given a string made up of one or more words separated by a single space.
+
+Write a script to capitalise the given title. If the word length is 1 or 2 then convert the word to lowercase otherwise make the first character uppercase and remaining lowercase.
+
+
+Example 1
+Input: $str = "PERL IS gREAT"
+Output: "Perl is Great"
+=end comment
+
+my @Test =
+    #   in                      exp
+    "PERL IS gREAT",        "Perl is Great",
+    "RaKU iS sMorES",    "Raku is Smores",
+;
+plan +@Test ÷ 2;
+
+sub task( $a is copy --> Str) {
+    $a.lc.words.map( { .chars < 3 ?? $_ !! tc $_ }).join: ' ';
+}
+
+for @Test -> $in, $exp, {
+    is task( $in), $exp, "{$exp // $exp.^name()} <- $in.raku()";
+}
+done-testing;
+
+my $str = "PERL IS gREAT";
+say qq{\nInput: \$str = "$str"\nOutput: "}, task($str), '"';
+