190

2 files changed, 226 insertions, 0 deletions

diff --git a/challenge-190/0rir/raku/ch-1.raku b/challenge-190/0rir/raku/ch-1.raku
new file mode 100644
index 0000000000..e9e8c344b6
--- /dev/null
+++ b/challenge-190/0rir/raku/ch-1.raku
@@ -0,0 +1,118 @@
+#!/usr/bin/env raku
+# :vim ft=raku sw=4 expandtab  # 🦋 ∅ ≡ ∩ ≢ ∈ «␤»
+use v6.d;
+use lib $?FILE.IO.parent(2).add("lib");
+use Test;
+
+=begin comment
+190-1: Capital Detection        Submitted by: Mohammad S Anwar
+
+Given a string with alphabetic characters only: A..Z and a..z.
+
+Determine if the usage of capitals is legal by complying with one
+of the following rules, and return 0 or the rule number satisfied:
+
+1) Only first letter is capital and all others are small.
+2) Every letter is small.
+3) Every letter is capital.
+
+Example 1
+Input: $s = 'Perl'
+Output: 1
+Example 2
+Input: $s = 'TPF'
+Output: 1
+Example 3
+Input: $s = 'PyThon'
+Output: 0
+Example 4
+Input: $s = 'raku'
+Output: 1
+=end comment
+
+=begin comment
+Often when doing a weekly challenge, I choose some scenario of usage to
+satisfy rather than just fulfilling the bare challenge reqs.
+
+This time, I have just imagined this requirement is of great import, has
+an undisclosed purpose, and should play well with NIH code.  So there is
+some effort to resolve the upper-case vs. title-case ambiguity, and to
+keep the configuration from polluting other namespaces.
+=end comment
+
+
+# %*ENV<ITUC-prefer> = Int;   # Set to 3 for UPPER, 1 for TITLE,
+
+
+# NOTE:  ?! Keeping enum scope narrow for Int namespace collision avoidance.
+enum Rule < FAIL-CASE TITLE-CASE LOWER-CASE UPPER-CASE>;
+
+sub is-title-or-a-uniform-case(
+            Any:D(Str) $s,
+            Int $ITUC-prefer = %*ENV<ITUC-prefer>;
+            --> Int
+) {
+    unless $ITUC-prefer == (UPPER-CASE, TITLE-CASE).any {
+        warn
+  "WARNING:  Default for title- vs upper-case preference has not been set\n"
+~ "    locally.  Using value for Timbuktu, Mali.  It is recommended to\n"
+~ "    set \%*ENV<ITUC-prefer> or parameter \$ITUC-prefer." ;
+       $ITUC-prefer = UPPER-CASE;
+    }
+    given $s {
+        when / ^ <:Lu>        $ / { return $ITUC-prefer }
+        when / ^ <:Ll>+       $ / { return LOWER-CASE }
+        when / ^ <:Lu>+       $ / { return UPPER-CASE }
+        when / ^ <:Lu> <:Ll>+ $ / { return TITLE-CASE }
+        when / ^ <:L>+        $ / { return  FAIL-CASE }
+        default {
+            die "I could handle this if my programmer had been smarter: '$s'";
+        }
+    }
+}
+
+multi MAIN ( ) {  MAIN('T' ) }
+
+multi MAIN ( $t where * = < T t>.any ) {
+
+    my @Test =
+        { s => 'U'     , upper => UPPER-CASE, title => TITLE-CASE },
+        { s => 'Raku'  , upper => TITLE-CASE, title => TITLE-CASE },
+        { s => 'RAKU'  , upper => UPPER-CASE, title => UPPER-CASE },
+        { s => 'raku'  , upper => LOWER-CASE, title => LOWER-CASE },
+        { s => 'Ul'    , upper => TITLE-CASE, title => TITLE-CASE },
+        { s => 'UU'    , upper => UPPER-CASE, title => UPPER-CASE },
+        { s => 'l'     , upper => LOWER-CASE, title => LOWER-CASE },
+        { s => 'll'    , upper => LOWER-CASE, title => LOWER-CASE },
+        { s => 'Perl'  , upper => TITLE-CASE, title => TITLE-CASE },
+        { s => 'lUlU'  , upper =>  FAIL-CASE, title =>  FAIL-CASE },
+        { s =>  'TPF'  , upper => UPPER-CASE, title => UPPER-CASE },
+        { s => 'PyThon', upper =>  FAIL-CASE, title =>  FAIL-CASE },
+        { s => 'pY'    , upper =>  FAIL-CASE, title =>  FAIL-CASE },
+=begin comment
+=end comment
+    ;
+
+    my @Dead =
+        { s => 'Ra ku', why => 'non-Letters'},
+        { s => 'Ra0ku', why => 'non-Letters'},
+        { s => ''     , why => 'empty Str'},
+        { s => (Str)  , why => 'undefined' },
+    ;
+
+    plan @Dead + +@Test × 2;
+    for @Dead -> %t {
+        %*ENV<TUC-prefer> = UPPER-CASE;
+        dies-ok { is-title-or-a-uniform-case( %t<s>) },
+                "dies: %t<why>, "
+                ~  ( %t<s>.defined ??  "'%t<s>'" !! %t<s>.raku);
+    }
+    for @Test -> %t {
+        is is-title-or-a-uniform-case( %t<s>, TITLE-CASE), %t<title>,
+                "%t<s> --> %t<title>";
+        is is-title-or-a-uniform-case( %t<s>, UPPER-CASE), %t<upper>,
+                "%t<s> --> %t<upper>";
+    }
+    done-testing;
+}
+
diff --git a/challenge-190/0rir/raku/ch-2.raku b/challenge-190/0rir/raku/ch-2.raku
new file mode 100644
index 0000000000..718825c4af
--- /dev/null
+++ b/challenge-190/0rir/raku/ch-2.raku
@@ -0,0 +1,108 @@
+#!/usr/bin/env raku
+# :vim ft=raku sw=4 expandtab  # 🦋 ∅ ≡ ∩ ≢ ∈ «␤»
+use v6.d;
+use Test;
+use experimental :macros;
+
+
+=begin comment
+190-2: Decoded List         Submitted by: Mohammad S Anwar
+
+Given a string, $s, consisting of a sequence of the decimal chars 1 to 9.
+Find the all valid different decodings for the given order.
+DEcoding is done by mapping A,B,C,D,… to 1,2,3,4,… etc.
+
+Example 2
+Input: $s = 1115
+Output: AAAE, AAO, AKE, KAE, KO
+
+Possible decoded data are:
+(1 1 1 5) => (AAAE)
+(1 1 15)  => (AAO)
+(1 11 5)  => (AKE)
+(11 1 5)  => (KAE)
+(11 15)   => (KO)
+=end comment
+
+macro n64chr( $n2chr) { quasi { ( {{{ $n2chr }}} + 64).chr} };
+
+macro two2one( $a, $b ) {
+    quasi {   ( {{{$a}}} ~ {{{$b}}}).Int < 27
+           ?? ( {{{$a}}} ~ {{{$b}}})
+           !! Str                             }
+}
+
+# Return an array of decoded values, if $justify is set return an
+# array contain the numeric values as shown above in the example,
+# otherwise return the complete decoding.
+sub decoder-str-NtoChar( Str:D $in, Bool:D :$justify = False --> Array ) {
+    my @in = $in.comb;
+    my @num;
+    @num[0].push: @in.shift;
+    for @in -> $n {
+        for 0 .. @num.end -> $i {
+            when not @num[$i][*-1].defined {
+                @num[$i].push: $n;       # suffix it
+            }
+            if my $tabby = two2one( @num[$i][*-1], $n ) {
+                my @a = | @num[$i], Str;
+                @a[*-2] = $tabby;
+                @num.push: @a;
+            }
+            @num[$i].push: $n;
+        }
+    }
+    @num = sort do for @num -> @a { @a.=grep: *.defined; }
+
+    return @num if $justify;
+
+    my @ret = gather for @num -> @a {
+        take @a.map( { n64chr( $_) } ).join;
+    }
+
+    return @ret;
+}
+
+multi MAIN ( Str $t where * = < T t>.any ) {
+
+    my @Test =
+        { in => '11'   , exp => [ < AA K >], },
+        { in => '1115' , exp => [ < AAAE AAO AKE KAE KO >], },
+        { in => '127'  , exp => [ < ABG LG >], },
+        { in => '34567893' , exp => [ < CDEFGHIC > ] },
+        { in => '111111' , exp => [<
+            AAAAAA AAAAK AAAKA AAKAA AAKK AKAAA AKAK AKKA
+            KAAAA  KAAK  KAKA  KKAA  KKK >], },
+        { in => '1324152617' , exp => [ <
+            ACBDAEBFAG ACBDAEBFQ ACBDAEZAG ACBDAEZQ
+            ACBDOBFAG  ACBDOBFQ  ACBDOZAG  ACBDOZQ
+            ACXAEBFAG  ACXAEBFQ  ACXAEZAG  ACXAEZQ
+            ACXOBFAG   ACXOBFQ   ACXOZAG   ACXOZQ
+            MBDAEBFAG  MBDAEBFQ  MBDAEZAG  MBDAEZQ
+            MBDOBFAG   MBDOBFQ   MBDOZAG   MBDOZQ
+            MXAEBFAG   MXAEBFQ   MXAEZAG   MXAEZQ
+            MXOBFAG    MXOBFQ    MXOZAG    MXOZQ > ] },
+        { in => '223162' , exp =>
+            [< BBCAFB  BBCPB  BWAFB  BWPB  VCAFB  VCPB >], },
+    ;
+
+    plan +@Test;
+    for @Test -> %t {
+        is-deeply decoder-str-NtoChar( %t<in>), @(%t<exp>),
+            "%t<in> -> @(%t<exp>)";
+    }
+    done-testing;
+}
+
+multi MAIN( $d = '223162' ) {
+    my @answer = decoder-str-NtoChar( $d);
+    my @num = decoder-str-NtoChar( $d, :justify);
+    die "Wrong! @answer"
+        unless @answer  ~~ [< BBCAFB BBCPB BWAFB BWPB VCAFB VCPB >];
+    say "Input: \$s = $d\nOutput: @answer[].join(', ')\n\nThe decoded data:";
+    for ^@answer.elems -> $i {
+        printf "(%-11s) => %-7s\n",  @num[$i], @answer[$i];
+    }
+}
+
+