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

4 files changed, 781 insertions, 0 deletions

diff --git a/challenge-200/athanasius/perl/ch-1.pl b/challenge-200/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..a966bda2e2
--- /dev/null
+++ b/challenge-200/athanasius/perl/ch-1.pl
@@ -0,0 +1,198 @@
+#!perl
+
+###############################################################################
+=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.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+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 { scalar @$a <=> scalar @$b } @slices;
+
+is sufficient here because sorting in Perl has been stable since v5.8.0
+(https://perldoc.perl.org/sort).
+
+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.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $TEST_FIELDS => 3;
+const my $USAGE       =>
+"Usage:
+  perl $0 [<array> ...]
+  perl $0
+
+    [<array> ...]    A list of 1 or more integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 200, Task #1: Arithmetic Slices (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @array = @ARGV;
+
+        for (@array)
+        {
+            / ^ $RE{num}{int} $ /x
+                or die qq[ERROR: "$_" is not a valid integer\n$USAGE];
+        }
+
+        printf "Input:  \@array = (%s)\n", join ',', @array;
+
+        my $slices = find_arithmetic_slices( \@array );
+
+        printf "Output: %s\n", format_slices( $slices );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find_arithmetic_slices
+#------------------------------------------------------------------------------
+{
+    my ($array) = @_;
+    my  @slices;
+
+    for my $i (0 .. $#$array - 2)
+    {
+        my $gap = $array->[ $i + 1 ] - $array->[ $i ];
+
+        L_INNER:
+        for my $j ($i + 2 .. $#$array)
+        {
+            if ($array->[ $j ] - $array->[ $j - 1 ] == $gap)
+            {
+                push @slices, [ (@$array)[ $i .. $j ] ];
+            }
+            else
+            {
+                last L_INNER;
+            }
+        }
+    }
+
+    @slices = sort { scalar @$a <=> scalar @$b } @slices;   # Sorting is stable
+
+    return \@slices;
+}
+
+#------------------------------------------------------------------------------
+sub format_slices
+#------------------------------------------------------------------------------
+{
+    my ($slices) = @_;
+    my  $gist    = '()';
+
+    if (scalar @$slices > 0)
+    {
+        $gist = join ', ', map { '(' . join( ',', @$_ ) . ')' } @$slices;
+    }
+
+    return $gist;
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $input, $expected) = split /\|/, $line, $TEST_FIELDS;
+
+        $input    =~ s/ ^ \s* (.+?) \s* $ /$1/x;              # Trim whitespace
+        $expected =~ s/ ^ \s* (.+?) \s* $ /$1/x;
+        $expected =~ s/   \s+             / /gx;
+
+        my @array  = split / , \s* /x, $input;
+        my $slices = find_arithmetic_slices( \@array );
+        my $got    = format_slices( $slices );
+
+        is $got, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+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)
diff --git a/challenge-200/athanasius/perl/ch-2.pl b/challenge-200/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..8f27aa4b35
--- /dev/null
+++ b/challenge-200/athanasius/perl/ch-2.pl
@@ -0,0 +1,199 @@
+#!perl
+
+###############################################################################
+=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!
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumption
+----------
+A "decimal" number is a non-negative integer.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $SPACE            => ' ';
+const my $HORIZONTAL_BAR   => '-';
+const my $VERTICAL_BAR     => '|';
+const my $SEVEN_SEG_HEIGHT =>  7;
+const my $SEVEN_SEG_WIDTH  =>  7;
+const my $SEPARATOR_WIDTH  =>  2;
+const my $DIGIT_WIDTH      => $SEVEN_SEG_WIDTH + $SEPARATOR_WIDTH;
+const my $SCREEN_WIDTH     => 80;
+const my $MAX_LINE_WIDTH   => $SCREEN_WIDTH - ($SCREEN_WIDTH % $DIGIT_WIDTH);
+const my @TRUTH_TABLE      =>
+         qw( abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg );
+const my $USAGE            =>
+"Usage:
+  perl $0 <decimal>
+  perl $0
+
+    <decimal>    A non-negative integer\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 200, Task #2: Seven Segment 200 (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my  $args = scalar @ARGV;
+
+    if ($args == 1)
+    {
+        my $decimal =  $ARGV[ 0 ];
+           $decimal =~ / ^ $RE{num}{int} $ /x
+                or error( qq["$_" is not a valid integer] );
+
+        print  "Input: $decimal\n";
+        printf "Output:\n\n%s", draw_number( $decimal );
+    }
+    else
+    {
+        error( "Expected 1 argument, found $args" );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub draw_number
+#------------------------------------------------------------------------------
+{
+    my ($decimal) = @_;
+
+    # 1. Draw the display
+
+    my   @lines;
+    push @lines, draw_horizontal( $decimal, 'a'      );
+    push @lines, draw_vertical  ( $decimal, 'f', 'b' );
+    push @lines, draw_horizontal( $decimal, 'g'      );
+    push @lines, draw_vertical  ( $decimal, 'e', 'c' );
+    push @lines, draw_horizontal( $decimal, 'd'      );
+
+    # 2. Now split long display lines to fit the screen width
+
+    my $display;
+
+    do
+    {
+        $display .= substr( $lines[ $_ ], 0, $MAX_LINE_WIDTH, '' ) . "\n"
+            for 0 .. $#lines;
+
+        $display .= "\n";
+
+    } while (length $lines[ 0 ] > 0);
+
+    chomp  $display;
+
+    return $display;
+}
+
+#------------------------------------------------------------------------------
+sub draw_horizontal
+#------------------------------------------------------------------------------
+{
+    my ($decimal, $seg) = @_;
+    my  $line;
+
+    for my $digit (split //, $decimal)
+    {
+        my $code =  $TRUTH_TABLE[ $digit ];
+        my $char = ($code =~ / $seg /x) ? $HORIZONTAL_BAR : $SPACE;
+
+        $line .= $SPACE x $SEPARATOR_WIDTH . $char x $SEVEN_SEG_WIDTH;
+    }
+
+    return $line;
+}
+
+#------------------------------------------------------------------------------
+sub draw_vertical
+#------------------------------------------------------------------------------
+{
+    my ($decimal, $l_seg, $r_seg) = @_;
+    my  $line;
+
+    for my $digit (split //, $decimal)
+    {
+        my $code   =  $TRUTH_TABLE[ $digit ];
+        my $l_char = ($code =~ / $l_seg /x) ? $VERTICAL_BAR : $SPACE;
+        my $r_char = ($code =~ / $r_seg /x) ? $VERTICAL_BAR : $SPACE;
+
+        $line .= $SPACE x  $SEPARATOR_WIDTH      . $l_char .
+                 $SPACE x ($SEVEN_SEG_WIDTH - 2) . $r_char;
+    }
+
+    return ($line, $line);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
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;
+}
+
+###############################################################################