200

2 files changed, 425 insertions, 0 deletions

diff --git a/challenge-200/0rir/raku/ch-1.raku b/challenge-200/0rir/raku/ch-1.raku
new file mode 100644
index 0000000000..1685f6a44a
--- /dev/null
+++ b/challenge-200/0rir/raku/ch-1.raku
@@ -0,0 +1,214 @@
+#!/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
+Task 1: Arithmetic Slices       Submitted by: Mohammad S Anwar
+
+Given an array of integers, find all Arithmetic Slices it contains.
+
+An integer array is called arithmetic if it has at least 3 elements and the
+differences between any three consecutive elements are the same.
+
+Example 1
+Input: @array = (1,2,3,4)
+Output: (1,2,3), (2,3,4), (1,2,3,4)
+Example 2
+Input: @array = (2)
+Output: () as no slice found.
+=end comment
+
+=begin interpretation
+Not finding anything that seems to authoritatively define an Arithmetic
+Slice.  I see 4 solutions:  Rising: 1,2,3,4,5.
+Falling: 4,3,2,1.  Both: which may have constraints re overlaps 1,2,3,4,3,2.
+And my choice absolute or Wavy: 1,2,1,2,3,2,3,2,1,2,3,4.
+=end interpretation
+
+
+constant MIN-LINKS = 3;
+
+my @Test-delta-top =
+    # in            deltas     max-runs  all-runs   out
+    [[],            [],        [],       [],        [],                 ],
+    [[0,1,4,9,15],  [1,3,5,6], [],       [],        [],                 ],
+    [[1,2,1],       [1,1],     [[0,2],], [[0,2],],  [[1,2,1],]          ],
+    [[1,1,2,1,1],   [0,1,1,0], [[1,3],], [[1,3],],  [[1,2,1],]          ],
+
+    [[1,2,3,3,2,1], [1,1,0,1,1],        [[0,2],[3,5]], [[0,2],[3,5]],
+                [[1,2,3],[3,2,1],]
+    ],
+    [[1,1,2,3,3,2,1,1], [0,1,1,0,1,1,0], [[1,3],[4,6]], [[1,3],[4,6]],
+                [[1,2,3,3,2,1],]
+    ], 
+    [[1,1,2,3,3,2,1], [0,1,1,0,1,1],    [[1,3],[4,6]], [[1,3],[4,6]],
+                [[ 1,2,3,3,2,1],]
+    ],
+    [[9,1,2,3,4,4,3,2,1,9], [8,1,1,1,0,1,1,1,8], [[1,4],[5,8]],
+        [[1,3], [2,4], [1,4], [5,7], [6,8], [5,8],],
+        [[1,2,3],[2,3,4],[1,2,3,4],[4,3,2],[3,2,1],[4,3,2,1],]
+    ],
+    [[1,2,3,4],     [1,1,1],   [[0,3],], [[0,2],[1,3],[0,3]],
+        [[1,2,3],[2,3,4],[1,2,3,4]],
+    ],
+    [[1,2,3,4,5],   [1,1,1,1],      [[0,4],],
+        [[0,2],[1,3],[2,4],[0,3],[1,4],[0,4]],
+        [[1,2,3],[2,3,4],[3,4,5],[1,2,3,4],[2,3,4,5],[1,2,3,4,5]]
+    ],
+    [[1,2,3,4,5,5], [1,1,1,1,0],    [[0,4],],
+        [[0,2],[1,3],[2,4],[0,3],[1,4],[0,4]],
+        [[1,2,3],[2,3,4],[3,4,5],[1,2,3,4],[2,3,4,5],[1,2,3,4,5]]
+    ],
+    [[1,1,2,3,4,5], [0,1,1,1,1],    [[1,5],],
+        [[1,3],[2,4],[3,5],[1,4],[2,5],[1,5]],
+        [[1,2,3],[2,3,4],[3,4,5],[1,2,3,4],[2,3,4,5],[1,2,3,4,5]]
+    ],
+    [[1,1,2,3,4,5,5], [0,1,1,1,1,0],  [[1,5],],
+        [[1,3],[2,4],[3,5],[1,4],[2,5],[1,5]],
+        [[1,2,3],[2,3,4],[3,4,5],[1,2,3,4],[2,3,4,5],[1,2,3,4,5]]
+    ],
+    [   [9,1,2,3,4,9,9,1,2,3,4,5,6,9,2,1,2],
+        [8,1,1,1,5,0,8,1,1,1,1,1,3,7,1,1],
+        [[1,4],[7,12],[14,16]],
+        [[1,3],[2,4],[1,4],
+            [7,9],[8,10],[9,11],[10,12],
+            [7,10],[8,11],[9,12],
+            [7,11],[8,12],
+            [7,12],
+            [14,16],
+        ],
+        [[1,2,3],[2,3,4],[1,2,3,4],
+            [1,2,3],[2,3,4],[3,4,5],[4,5,6],
+            [1,2,3,4],[2,3,4,5],[3,4,5,6],
+            [1,2,3,4,5], [2,3,4,5,6],
+            [1,2,3,4,5,6],
+            [2,1,2],
+        ],
+    ]
+;
+
+plan 5 × @Test-delta-top.elems; 
+
+for @Test-delta-top -> @t {
+    is my $R = get-deltas( @t[0]), @t[1],
+            "in @t[0].raku() to delta";
+    is top-runs( @t[1]), @t[2],
+            "delta @t[1].raku() to top-runs";
+    is sub-runs( @t[2]), @t[3],
+            "top-runs @t[2].raku() to sub-runs";
+    is range-to-slice( @t[0],@t[3]),@t[4],
+            "sub-runs  @t[3].raku() to out";
+    is slices( @t[0]),@t[4], "all-steps-combined";
+}
+
+done-testing;
+
+
+multi slices( @in where *.end < MIN-LINKS -1, --> Array ) { [] }
+
+multi slices( @in ) {
+    my @dif = get-deltas( @in);
+    range-to-slice( @in, 
+        sub-runs(
+            top-runs( @dif,  MIN-LINKS ), MIN-LINKS-1));
+}
+
+
+multi get-deltas( @in where *.end ≥ MIN-LINKS-2 ) {
+    map { abs( $_[0] - $_[1]) }, @in.rotor(2 => -1); # XXX abs() see below.
+}
+
+# for testing only, callers constrain @in size
+multi get-deltas( @in where *.end < MIN-LINKS-2) { [] }
+
+sub top-runs( @dif, $min-links = MIN-LINKS, --> Array) {
+    my $chain;          # Array size 2
+    my @chain = [];     # A o A of indices to longest runs in @in.
+    my $i = 0;
+    while $i < @dif.end {
+        while $i < @dif.end and @dif[$i] ≠ @dif[$i + 1] {       # hunt
+            ++ $i;
+        }
+        # XXX Poor design choice.
+        # Instead of using abs() in get-deltas(), using alternate comparison
+        # functions in this if-statement could allow slices that are
+        # constrained to rise, to fall, to rise, or be wavy.
+        # Using abs() earlier eliminated info needlessly.
+        if $i < @dif.end and ( @dif[$i] == @dif[$i + 1]) {      # found a link
+            $chain = [ $i, ($ = $i+2)];
+            ++ $i;
+
+            while $i < @dif.end and @dif[$i] == @dif[$i + 1] {  # follow it
+                ++ @$chain[1];
+                ++ $i;
+            }
+            if @$chain[1] - @$chain[0] ≥ -1 + $min-links {     # keep it
+                @chain.push: $chain;
+            } 
+            $chain = [];                                    # throw it back
+        }
+    }
+    return @chain;
+}
+
+=begin pod
+
+sub-runs( @chain, $min-size --> Array )
+
+@chain contains dyads like, here two, [[6,9],[20,24]] denoting sequences
+of successive integers.  This returns those and all shorter sequences they
+contain which have at least $min-size elements.  Here with $min-size = 3
+we have [[6,9],[6,8],[7,9], [20,24],[20,23],[21,24], [20,22],[21,23],[22,24]].
+
+=end pod
+
+sub sub-runs( @chain, $min-size = MIN-LINKS-1 --> Array ) {
+    my @ret;
+    return [] if @chain == []; # quick KLUGE -- missed the no sub-runs case
+
+     for @chain -> @x {
+        my ($head,$tail) = @x;
+        my $span = $min-size;
+        my $span-stop = $tail - $head;
+        while $span ≤ $span-stop {
+            my ($h, $t) = $head, $head + $span;
+            while $t ≤  $tail {
+                @ret.push: [$h<>,$t<>];                 #[[]] pair
+                ++«($h, $t);                            #same t
+            }
+            ++ $span;
+        }
+    }
+
+    # quick KLUGE -- missed the no sub-runs case
+    return @chain if [] == @ret;
+    return @ret;                                        #same t
+}
+=begin pod
+sub range-to-slice( @in, @dyad --> Array ); 
+
+Returns an AoA using values from @in. Each @dyad elem is used
+as a range to create an element array in the returned array.
+=end pod
+
+sub range-to-slice( @in, @dyad --> Array ) {
+    my @return;
+    for @dyad -> ($a, $z) { @return.push: @in[ $a..$z] }
+    @return;
+}
+
+my @array = [9,1,2,3,4,9,9,1,2,3,4,5,6,9,2,1,2];
+
+my @abs-exp = [[1,2,3],[2,3,4],[1,2,3,4],
+                [1,2,3],[2,3,4],[3,4,5],[4,5,6],
+                [1,2,3,4],[2,3,4,5],[3,4,5,6],
+                [1,2,3,4,5], [2,3,4,5,6],
+                [1,2,3,4,5,6],
+                [2,1,2]];
+
+say "\n\nSolving arithmetic slices with absolute deltas.\n";
+my @got = &slices( @array); 
+say " Input: \@array = @array[]\n Output: ", @got;
+die 'slice failed' unless @got ~~ @abs-exp;
diff --git a/challenge-200/0rir/raku/ch-2.raku b/challenge-200/0rir/raku/ch-2.raku
new file mode 100644
index 0000000000..d21aabff98
--- /dev/null
+++ b/challenge-200/0rir/raku/ch-2.raku
@@ -0,0 +1,211 @@
+#!/usr/bin/env raku
+# :vim ft=raku sw=4 expandtab  # 🦋 ∅ ≡ ∩ ≢ ∈ «␤»
+use v6.d;
+
+=begin comment
+
+200-2: Seven Segment 200            Submitted by: Ryan J Thompson
+
+A seven segment display is an electronic component, usually used to display digits. The segments are labeled 'a' through 'g' as shown below:
+
+The encoding of each digit can thus be represented compactly as a truth table:
+
+my @truth = qw<abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg>;
+For example, $truth[1] = ‘bc’. The digit 1 would have segments ‘b’ and ‘c’ enabled.
+
+Write a program that accepts any decimal number and draws that number as a horizontal sequence of ASCII seven segment displays, similar to the following:
+                                    a
+-------  -------  -------        -------
+      |  |     |  |     |      f |     | b
+      |  |     |  |     |        |  g  |
+-------                          -------
+|        |     |  |     |        |     |
+|        |     |  |     |      e |     | c
+-------  -------  -------        -------
+                                    d
+To qualify as a seven segment display, each segment must be drawn (or not drawn) according to your @truth table.
+=end comment
+
+=begin graphic
+
+  4x5    5x5    3x3  4x3       7x7
+0 ----  -----    _    __      8888888
+1 |  |  |   |   |_|  |__|     8     8
+2 ----  -----   |_|  |__|     8     8
+3 |  |  |   |                 8888888
+4 ----  -----                 8     8
+5                             8     8
+6                             8888888
+=end graphic
+
+
+#------------------------------------------------------------------------
+#  Font Definition
+
+#   s/b *- a role
+#       *- pun-able as is.
+#       *- control order of segment assembly, if necessary
+#       *- control inter-char space
+#
+#  Defining a grid array upon which to create glyphs would allow having
+#  and sharing of the insections of segments.  This could better emulate
+#  displays by avoiding gaps between "adjacent" segments on larger fonts.
+#  Overlapping segments seemed against the challenge's spec.
+
+my $basic-font = {
+    name => 'basic3x3',
+    h => 3,
+    w => 3,
+    x-space => 1,
+    y-space => 1,
+    build_order => < a f g b e d c >,
+    post-proc => sub ( $char, @glyph) { return @glyph },
+    segments => {
+            # segment out put for requested state
+         a => [ { row => 0, True => ' _ ', False => '   ' }, ],
+         f => [ { row => 1, True => '|',   False => ' '   }, ],
+         g => [ { row => 1, True => '_',   False => ' '   }, ],
+         b => [ { row => 1, True => '|',   False => ' '   }, ],
+         e => [ { row => 2, True => '|',   False => ' '   }, ],
+         d => [ { row => 2, True => '_',   False => ' '   }, ],
+         c => [ { row => 2, True => '|',   False => ' '   }, ],
+    }
+};
+
+my $uni-font = {
+    name => 'uni5x5',
+    h => 5,
+    w => 5,
+    x-space => 2,
+    y-space => 1,
+    build_order => < f e a d g b c >,
+    post-proc => sub ( $char, @glyph) { return @glyph },
+    segments => {
+        a => [ { row => 0, True => '━━━',  False => '   '  }, ],
+        b => [ { row => 0, True => '╻',    False => ' '    },
+               { row => 1, True => '┃',    False => ' '    }, ],
+        c => [ { row => 2, True => '┒',    False => ' '    },
+               { row => 3, True => '┃',    False => ' '    },
+               { row => 4, True => '╹',    False => ' '    }, ],
+        d => [ { row => 4, True => '━━━',  False => '   '  }, ],
+        e => [ { row => 2, True => '┎',    False => ' '    },
+               { row => 3, True => '┃   ', False => '    ' },
+               { row => 4, True => '╹',    False => ' '    }, ],
+        f => [ { row => 0, True => '╻',    False => ' '    },
+               { row => 1, True => '┃   ', False => '    ' }, ],
+        g => [ { row => 2, True => '━━━',  False => '   '  }, ],
+    }
+};
+
+my $post-font = {
+    name => 'mirror7x7',
+    h => 7,
+    w => 7,
+    x-space => 3,
+    y-space => 1,
+    post-proc => sub ( $char, @glyph) {
+        for @glyph -> $str is rw {
+            $str.=subst: /\S/, $char.uc, :g ;
+        }
+        return @glyph;
+    },
+    build_order => < a f b d e c g >,
+    segments => {
+        a => [ { row => 0, True => '-------', False => '       '  }, ],
+        f => [ { row => 1, True => '|     ',  False => '      '   },
+               { row => 2, True => '|     ',  False => '      '   }, ],
+        b => [ { row => 1, True => '|',       False => ' '        },
+               { row => 2, True => '|',       False => ' '        }, ],
+        g => [ { row => 3, True => '-------', False => '       '  }, ],
+        e => [ { row => 4, True => '|     ',  False => '      '   },
+               { row => 5, True => '|     ',  False => '      '   }, ],
+        c => [ { row => 4, True => '|',       False => ' '        },
+               { row => 5, True => '|',       False => ' '        }, ],
+        d => [ { row => 6, True => '-------', False => '       '  }, ],
+    }
+};
+
+#------------------------------------------------------------------------
+# s/b a renderer class
+
+constant $SP = ' ';
+
+    # the s7 alphabet by segments active: 0-9, a-f etc., $SP is a blank.
+    # 
+constant %abc =
+          0 => 'abcdef.', 1 => '.bc....', 2 => 'ab.de.g', 3 => 'abcd..g',
+          4 => '.bc..fg', 5 => 'a.cd.fg', 6 => 'a.cdefg', 7 => 'abc....',
+          8 => 'abcdefg', 9 => 'abc..fg', a => 'abc.efg', b => '..cdefg',
+          c => 'a..def.', d => '.bcde.g', e => 'a..defg', f => 'a...efg',
+          h => '..c.efg', i => '..c....', j => '.bcde..', l => '...def.',
+          o => '..cde.g', n => '..c.e.g', p => 'ab..efg', u => '..cde..',
+        $SP => '.......',
+;
+
+#Build and cache a font.
+sub build-font( $font = $basic-font --> Hash) {
+    my %return;
+    %return<font-def> = $font;
+    for %abc.keys.sort -> $c {
+        # decode-char
+        my %segdef = $font<segments>;
+        my %ref = [Z=>] <a b c d e f g >,
+                %abc{$c}.comb.Array.map({ $_= $_ !~~ '.' ?? True !! False});
+        my @order = map { Pair.new( $_, %ref{$_})}, $font<build_order>.flat;
+
+        my @image =  '' x $font<h>;
+        for @order -> ( :key($seg), :value($active) ) {
+            for ^%segdef{$seg} -> $i {
+                next unless %segdef{$seg}[$i].defined;   # not in row
+                @image[ %segdef{$seg}[$i]<row>] ~= %segdef{$seg}[$i]{$active};
+            }
+        }
+        @image = $font<post-proc>( $c, @image);
+        %return{$c} = @image;
+    }
+    %return;
+}
+
+sub render( %built-font, $in = '200 200' --> Array) {
+    my @return;
+    my $font = %built-font<font-def>;
+
+    for ^$font<h> -> $r {
+        @return[$r] = '';
+    }
+    for $in.comb -> $ch {
+        for ^$font<h> -> $r {
+            @return[$r] ~= %built-font{$ch}[$r] ~ (' ' x $font<x-space>);
+        }
+    }
+    @return
+}
+
+sub print7( @rendered ) {
+    print "\n";
+    for ^@rendered -> $n {
+        say @rendered[$n];
+    }
+}
+
+#------------------------------------------------------------------------
+# user
+my %basic =  build-font( $basic-font );
+my %uni = build-font( $uni-font);
+my %post = build-font( $post-font);
+
+print7( render( %basic, '01234 56789'));
+print7( render( %basic, 'abcdefhijlnopu'));
+
+print7( render(%uni,'0123456789'));
+print7( render(%uni, 'abcdefjlnou'));
+
+print7( render(%post,'01234567'));
+print7( render(%post,'89abcdef'));
+print7( render(%post,'jlnou'));
+print7( render(%post,' '));
+
+print7( render(%uni, 'happi'));
+print7( render(%post, '200 2 u'));
+print7( render(%basic, 'happi 200 2 u'));
+