Perl & Raku solutions to Tasks 1 & 2 for Week 200

2 files changed, 384 insertions, 0 deletions

diff --git a/challenge-200/athanasius/raku/ch-1.raku b/challenge-200/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..ec7af62693
--- /dev/null
+++ b/challenge-200/athanasius/raku/ch-1.raku
@@ -0,0 +1,204 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 200
+=========================
+
+TASK #1
+-------
+*Arithmetic Slices*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to find out all Arithmetic Slices for the given array of
+integers.
+
+
+    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
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If the first argument is negative, it must be preceded by "--" to distin-
+   guish it from a command-line flag.
+
+Output Order
+------------
+As per Example 1, the slices are ordered by increasing size; slices of the same
+size are preserved in the order in which they were found (scanning the array by
+increasing indices). Note that the simple statement:
+
+    @slices.= sort: { $^a.elems <=> $^b.elems };
+
+is sufficient here because sorting in Raku is stable [1].
+
+Note
+----
+In the case where the difference between consecutive elements is zero, the same
+slice may appear multiple times in the output. For example, an input array of
+(4,4,4,4) produces the output (4,4,4), (4,4,4), (4,4,4,4). I assume this is the
+desired result.
+
+Reference
+---------
+[1] https://docs.raku.org/syntax/stable%20sort#:~:text=Computer%20scientists%20
+    call%20this%20a,the%20number%20of%20matches%20won
+
+=end comment
+#==============================================================================
+
+use Test;
+
+my UInt constant $TEST-FIELDS = 3;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 200, Task #1: Arithmetic Slices (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    #| A list of 1 or more integers
+
+    *@array where { .elems >= 1 && .all ~~ Int:D }
+)
+#==============================================================================
+{
+    "Input:  \@array = (%s)\n".printf: @array.join: ',';
+
+    my Array[Int] @slices = find-arithmetic-slices( @array );
+
+    "Output: %s\n".printf: format-slices( @slices );
+}
+
+#==============================================================================
+multi sub MAIN()                                 # No input: run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub find-arithmetic-slices( List:D[Int:D] $array --> List:D[List:D[Int:D]] )
+#------------------------------------------------------------------------------
+{
+    my Array[Int] @slices;
+
+    for 0 .. $array.end - 2 -> UInt $i
+    {
+        my Int $gap = $array[ $i + 1 ] - $array[ $i ];
+
+        L-INNER:
+        for $i + 2 .. $array.end -> UInt $j
+        {
+            if $array[ $j ] - $array[ $j - 1 ] == $gap
+            {
+                @slices.push: Array[Int].new: $array[ $i .. $j ];
+            }
+            else
+            {
+                last L-INNER;
+            }
+        }
+    }
+
+    @slices.= sort: { $^a.elems <=> $^b.elems };   # Raku sorting is stable [1]
+
+    return @slices;
+}
+
+#------------------------------------------------------------------------------
+sub format-slices( List:D[List:D[Int:D]] $slices --> Str:D )
+#------------------------------------------------------------------------------
+{
+    my Str $gist = '()';
+
+    if $slices.elems > 0
+    {
+        $gist = $slices.map( { '(' ~ @$_.join( ',' ) ~ ')' } ).join: ', ';
+    }
+
+    return $gist;
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $input, $expected) =
+                $line.split: / \| /, $TEST-FIELDS;
+
+        $input    ~~ s/ ^ \s* (.+?) \s* $ /$0/;               # Trim whitespace
+        $expected ~~ s/ ^ \s* (.+?) \s* $ /$0/;
+        $expected ~~ s:g/ \s+ / /;
+
+        my Int        @array  = $input.split( / \, \s* / ).map: { .Int };
+        my Array[Int] @slices = find-arithmetic-slices( @array );
+        my Str        $got    = format-slices( @slices );
+
+        is $got, $expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1 | 1,2,3,4         |(1,2,3), (2,3,4), (1,2,3,4)
+        Example 2 | 2               |()
+        Evens     | 1,2,4,6,8,9     |(2,4,6), (4,6,8), (2,4,6,8)
+        Odds      |-1,1,3,4,5,7,9,10|(-1,1,3), (3,4,5), (5,7,9)
+        Decreasing|10,7,4,3,2,1     |(10,7,4), (4,3,2), (3,2,1), (4,3,2,1)
+        Up & down |-1,1,3,2,1,0     |(-1,1,3), (3,2,1), (2,1,0), (3,2,1,0)
+        Unchanging| 0,42,42,42,42,17|(42,42,42), (42,42,42), (42,42,42,42)
+        END
+}
+
+###############################################################################
diff --git a/challenge-200/athanasius/raku/ch-2.raku b/challenge-200/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..1154877b0e
--- /dev/null
+++ b/challenge-200/athanasius/raku/ch-2.raku
@@ -0,0 +1,180 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 200
+=========================
+
+TASK #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:
+
+    __a__
+   |     |
+  f|     |b
+   |__g__|
+   |     |
+  e|     |c
+   |__d__|
+
+
+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:
+
+  -------  -------  -------
+        |  |     |  |     |
+        |  |     |  |     |
+  -------
+  |        |     |  |     |
+  |        |     |  |     |
+  -------  -------  -------
+
+To qualify as a seven segment display, each segment must be drawn (or not
+drawn) according to your @truth table.
+
+The number "200" was of course chosen to celebrate our 200th week!
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumption
+----------
+A "decimal" number is a non-negative integer.
+
+=end comment
+#==============================================================================
+
+my Str  constant $SPACE            = ' ';
+my Str  constant $HORIZONTAL-BAR   = '-';
+my Str  constant $VERTICAL-BAR     = '|';
+my UInt constant $SEVEN-SEG-HEIGHT =  7;
+my UInt constant $SEVEN-SEG-WIDTH  =  7;
+my UInt constant $SEPARATOR-WIDTH  =  2;
+my UInt constant $DIGIT-WIDTH      = $SEVEN-SEG-WIDTH + $SEPARATOR-WIDTH;
+my UInt constant $SCREEN-WIDTH     = 80;
+my UInt constant $MAX-LINE-WIDTH   = $SCREEN-WIDTH -
+                                    ($SCREEN-WIDTH % $DIGIT-WIDTH);
+my      constant @TRUTH-TABLE      = Array[Str].new:
+                 < abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg >;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 200, Task #2: Seven Segment 200 (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    UInt:D $decimal                 #= A non-negative integer
+)
+#==============================================================================
+{
+    "Input: $decimal".put;
+
+    "Output:\n\n%s".printf: draw-number( $decimal );
+}
+
+#------------------------------------------------------------------------------
+sub draw-number( UInt:D $decimal --> Str:D )
+#------------------------------------------------------------------------------
+{
+    # 1. Draw the display
+
+    my Str @lines;
+
+    @lines.push:  draw-horizontal( $decimal, 'a'      );
+    @lines.push: |draw-vertical\ ( $decimal, 'f', 'b' );
+    @lines.push:  draw-horizontal( $decimal, 'g'      );
+    @lines.push: |draw-vertical\ ( $decimal, 'e', 'c' );
+    @lines.push:  draw-horizontal( $decimal, 'd'      );
+
+    # 2. Now split long display lines to fit the screen width
+
+    my Str $display;
+
+    repeat
+    {
+        for 0 .. @lines.end -> UInt $i
+        {
+            @lines[ $i ] ~~ s/ ^ (. ** { 1 .. $MAX-LINE-WIDTH }) //;
+
+            $display ~= $0.Str ~ "\n";
+        }
+
+        $display ~= "\n";
+
+    } while @lines[ 0 ].chars > 0;
+
+    return $display.chomp;
+}
+
+#------------------------------------------------------------------------------
+sub draw-horizontal( UInt:D $decimal, Str:D $seg --> Str:D )
+#------------------------------------------------------------------------------
+{
+    my Str $line;
+
+    for $decimal.split( '', :skip-empty ) -> Str $digit
+    {
+        my Str $code =  @TRUTH-TABLE[ $digit.UInt ];
+        my Str $char = ($code ~~ / $seg /) ?? $HORIZONTAL-BAR !! $SPACE;
+
+        $line ~= $SPACE x $SEPARATOR-WIDTH ~ $char x $SEVEN-SEG-WIDTH;
+    }
+
+    return $line;
+}
+
+#------------------------------------------------------------------------------
+sub draw-vertical( UInt:D $dec, Str:D $l-seg, Str:D $r-seg --> List:D[Str:D] )
+#------------------------------------------------------------------------------
+{
+    my Str $line;
+
+    for $dec.split( '', :skip-empty ) -> Str $digit
+    {
+        my Str $code   =  @TRUTH-TABLE[ $digit.UInt ];
+        my Str $l-char = ($code ~~ / $l-seg /) ?? $VERTICAL-BAR !! $SPACE;
+        my Str $r-char = ($code ~~ / $r-seg /) ?? $VERTICAL-BAR !! $SPACE;
+
+        $line ~= $SPACE x  $SEPARATOR-WIDTH      ~ $l-char ~
+                 $SPACE x ($SEVEN-SEG-WIDTH - 2) ~ $r-char;
+    }
+
+    return $line, $line;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+###############################################################################