215

2 files changed, 186 insertions, 0 deletions

diff --git a/challenge-215/0rir/raku/ch-1.raku b/challenge-215/0rir/raku/ch-1.raku
new file mode 100644
index 0000000000..63b006ff0d
--- /dev/null
+++ b/challenge-215/0rir/raku/ch-1.raku
@@ -0,0 +1,96 @@
+#!/usr/bin/env raku
+# :vim ft=raku sw=4 expandtab  # 🦋 ∅∪∩∋∈∉ ≡ ≢ «␤ » ∴
+use v6.d;
+use Test;
+
+=begin comment
+215 1: Odd one Out          Submitted by: Mohammad S Anwar
+Given a list of words (alphabetic characters only) of same size, remove all
+words not sorted alphabetically and print the number of words in the list
+that are not alphabetically sorted.
+
+Input: @words = ('abc', 'xyz', 'tsu')
+Output: 1
+
+The words 'abc' and 'xyz' are sorted and can't be removed.
+The word 'tsu' is not sorted and hence can be removed.
+Example 2
+Input: @words = ('rat', 'cab', 'dad')
+Output: 3
+
+None of the words in the given list are sorted.
+Therefore all three needs to be removed.
+Example 3
+Input: @words = ('x', 'y', 'z')
+Output: 0
+
+=end comment
+
+=begin hmmm
+   The spec can be read as dealing with words with characters out of order,
+   or with the words that are out of order.
+   Solutions for both are below.
+=end hmmm
+
+# Return count of words in @a whose chars are not in alphabetic order.
+sub disorderly-char( @a -->Int) {
+    die 'Void' if @a == [];
+
+    my $bad = 0; 
+    for @a -> $w {
+        ++$bad if $w !~~ $w.comb.sort.join;
+    }
+    $bad;
+}
+
+# Return count of words in @a which are not in alphabetic order.
+sub disorderly-list( @a -->Int) {
+    die 'Void' if @a == [];
+
+    return 0 if @a.elems == 1;
+    return @a.end if @a[0] gt @a[1];
+
+    quietly @a.end - (@a,(@a[*-1]~'a')).flat.first: { $_ gt @a[ ++$ ]}, :k;
+}
+
+my @Test =
+    # data       char-exp   list-exp
+    <x y z>,            0,  0,
+    <abc xyz tsu>,      1,  1,
+    <rat cab dad>,      3,  2,
+    ('a',),             0,  0,
+    ('b','a'),          0,  1,
+    <b b>,              0,  0,
+    ('abc',),           0,  0,
+    ('cba',),           1,  0,
+    <za za ab az xa>,   3,  3,
+    <az za>,            1,  0,
+    <a a b b b >,       0,  0,
+    <uv wx yz aa>,      0,  1,
+    <uv wx yz aa cb>,   1,  2,
+    <uv wx aa>,         0,  1,
+    <uv wx aa cb>,      1,  2,
+;
+
+my @Dead = [(),];
+
+plan 2 × @Test/3 + 2 × @Dead;
+
+for @Dead -> @in {
+    dies-ok { disorderly-char(@in)}, "@in.raku.Str() by chars dies";
+    dies-ok { disorderly-list(@in)}, "@in.raku.Str() by words dies";
+}
+for @Test -> @in, $char, $word {
+    is disorderly-char(@in), $char, "by chars: $char <= @in[]";
+    is disorderly-list(@in), $word, "by words: $word <= @in[]";
+}
+
+done-testing;
+
+my @word =('xyz', 'abc', 'tsu');
+say "\nInput: @word = @word[]\nOutput: ", disorderly-char(@word),
+            "                   # by chars";
+say "\nInput: @word = @word[]\nOutput: ", disorderly-list(@word),
+            "                   # by words";
+exit;
+
diff --git a/challenge-215/0rir/raku/ch-2.raku b/challenge-215/0rir/raku/ch-2.raku
new file mode 100644
index 0000000000..f8dc191d92
--- /dev/null
+++ b/challenge-215/0rir/raku/ch-2.raku
@@ -0,0 +1,90 @@
+#!/usr/bin/env raku
+# :vim ft=raku sw=4 expandtab  # 🦋 ∅∪∩∋∈∉ ≡ ≢ «␤ » ∴
+use v6.d;
+use Test;
+
+=begin comment
+215-2: Number Placement          Submitted by: Mohammad S Anwar
+Given a list of numbers having just 0 and 1, and also a placement count (>=1).
+
+Find if it is possible to replace 0 with 1 in the given list. The only condition is that you can only replace when there is no 1 on either side. Print 1 if it is possible otherwise 0.
+
+Example 1:
+Input: @numbers = (1,0,0,0,1), $count = 1
+Output: 1
+
+You are asked to replace only one 0 as given count is 1.
+We can easily replace middle 0 in the list i.e. (1,0,1,0,1).
+Example 2:
+Input: @numbers = (1,0,0,0,1), $count = 2
+Output: 0
+
+You are asked to replace two 0's as given count is 2.
+It is impossible to replace two 0's.
+Example 3:
+Input: @numbers = (1,0,0,0,0,0,0,0,1), $count = 3
+Output: 1
+=end comment
+
+my @Test =
+    (1,),        1, False,
+    (1,1,),      1, False,
+    (1,1,1),     1, False,
+    (0,0,0),     1, True,
+    (0,0,0,0),   1, True,
+    (0,0,0,0),   2, False,
+    (0,0,0,0,0), 1, True,
+    (0,0,0,0,0), 2, True,
+    (0,0,0,0,0), 3, False,
+    (1,0,0,0),   1, True,
+    (0,0,0,1),   1, True,
+    (1,0,0,0,1), 1, True,
+    (1,0,0,0,1), 2, False,
+    (1,0,0,0,0,0,0,0,1), 1, True,
+    (1,0,0,0,0,0,0,0,1), 2, True,
+    (1,0,0,0,0,0,0,0,1), 3, True,
+    (1,0,0,0,0,0,0,0,1), 4, False,
+    [1,0,0,0,0,0,0,0,1], 4, False,
+;
+my @Dead =
+    List,           Int,
+    List,           1,
+    Array,          Int,
+    Array,          1,
+    (),             Any,
+    (),             5,
+    [],             2,
+    (1,0,0,0,1),    0,
+;
+plan +@Test ÷ 3 + @Dead ÷ 2;
+
+multi intersperseQ( @a where !@a.DEFINITE, $n -->Bool) { die 'Arg @a undefined'}
+multi intersperseQ( @a where * ~~ Empty,   $n -->Bool) { die 'Arg @a empty'}
+multi intersperseQ( @a,  Any:D             $n where * < 1 -->Bool)
+                                                       { die 'Arg $n invalid'}
+multi intersperseQ( @a where *.end < 2,    $n -->Bool) { False }
+multi intersperseQ( @a,                    $n -->Bool) {
+    my ($ct, $i) = 0, 0;
+    while $i <= @a.end - 2 {
+        when @a[$i..$i+2].all ~~ 0 {
+            return True if ++$ct == $n;
+            $i += 2;
+        }
+        ++$i;
+    }
+    return False;
+}
+
+for @Test -> @in, $n, $exp {
+    is intersperseQ( @in, $n), $exp, "$exp\t<= $n into @in[]";
+}
+for @Dead -> @in, $n {
+    dies-ok { intersperseQ( @in, $n)}, "dies '$n.raku()' into '@in.raku()'"
+}
+done-testing;
+
+my @number = 1,0,0,0,0,0,0,0,1;
+my $count = 3;
+put "\n\nInput: @number = @number[], \$count = $count\nOutput: ",
+        intersperseQ( @number, $count).Int;
+exit;