diff options
| -rw-r--r-- | challenge-200/0rir/raku/ch-1.raku | 214 | ||||
| -rw-r--r-- | challenge-200/0rir/raku/ch-2.raku | 211 |
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')); + |