Perl & Raku solutions to Tasks 1 & 2 of the Perl Weekly Challenge #098

On branch branch-for-challenge-098
Changes to be committed:
	new file:   challenge-098/athanasius/perl/alpha.txt
	new file:   challenge-098/athanasius/perl/ch-1.pl
	new file:   challenge-098/athanasius/perl/ch-2.pl
	new file:   challenge-098/athanasius/perl/digit.txt
	new file:   challenge-098/athanasius/raku/alpha.txt
	new file:   challenge-098/athanasius/raku/ch-1.raku
	new file:   challenge-098/athanasius/raku/ch-2.raku
	new file:   challenge-098/athanasius/raku/digit.txt

8 files changed, 582 insertions, 0 deletions

diff --git a/challenge-098/athanasius/perl/alpha.txt b/challenge-098/athanasius/perl/alpha.txt
new file mode 100644
index 0000000000..e85d5b4528
--- /dev/null
+++ b/challenge-098/athanasius/perl/alpha.txt
@@ -0,0 +1 @@
+abcdefghijklmnopqrstuvwxyz
\ No newline at end of file
diff --git a/challenge-098/athanasius/perl/ch-1.pl b/challenge-098/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..243d89154f
--- /dev/null
+++ b/challenge-098/athanasius/perl/ch-1.pl
@@ -0,0 +1,153 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 098
+=========================
+
+Task #1
+-------
+*Read N-characters*
+
+Submitted by: Mohammad S Anwar
+
+You are given file $FILE.
+
+Create subroutine readN($FILE, $number) returns the first n-characters and
+moves the pointer to the (n+1)th character.
+
+Example:
+
+ Input: Suppose the file (input.txt) contains "1234567890"
+ Output:
+     print readN("input.txt", 4); # returns "1234"
+     print readN("input.txt", 4); # returns "5678"
+     print readN("input.txt", 4); # returns "90"
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+The subroutine readN()'s parameter $FILE is a file *name*. In Perl, a file
+*handle* contains an in-built pointer to the next character. So, the implemen-
+tation of readN() given below uses a local but persistent hash to match file
+names to their corresponding handles; the remaining bookkeeping for the file
+pointer is then performed "under the hood" by Perl itself.
+
+The MAIN code demonstrates readN()'s functionality using two small files:
+'digit.txt' contains the digits 1 to 9 and 0 as in the Example, and 'alpha.txt'
+contains the lowercase letters a to z. MAIN calls readN() ten times with alter-
+nating filenames and assorted values of $number to show that:
+  -- calls with different filenames are handled independently of each other
+  -- readN() "remembers" the position of the next character from one call to
+     another
+  -- once the file is exhausted, calls to readN() return the empty string.
+
+To be useful in practice, the readN() subroutine should also have a reset
+facility. This is provided via a third, optional parameter to readN().
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use feature        qw( state );
+use Const::Fast;
+use Fcntl          qw( :seek );
+use Regexp::Common qw( number );
+
+const my $DIGIT => 'digit.txt';
+const my $ALPHA => 'alpha.txt';
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 098, Task #1: Read N-characters (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args == 0
+            or die sprintf 'ERROR: Found %d command-line argument%s, ' .
+                           "expected none\n", $args, ($args == 1) ? '' : 's';
+
+    open( my $digit_fh, '<', $DIGIT )
+        or die qq[Can't open file "$DIGIT" for reading, stopped];
+
+    open( my $alpha_fh, '<', $ALPHA )
+        or die qq[Can't open file "$ALPHA" for reading, stopped];
+
+    print    "Input:\n";
+    printf qq[  File "%s" contains "%s"\n], $DIGIT, <$digit_fh>;
+    printf qq[  File "%s" contains "%s"\n], $ALPHA, <$alpha_fh>;
+    print  "\nOutput:\n";
+
+    for ( [$DIGIT => 4], [$ALPHA => 5], [$DIGIT => 3], [$ALPHA => 3],
+          [$DIGIT => 1], [$ALPHA => 4], [$DIGIT => 7], [$ALPHA => 4],
+          [$DIGIT => 2], [$DIGIT => 2, 1] )
+    {
+        my ($FILE, $number) = @$_;
+        my  $string = readN( $FILE, $number );
+
+        printf qq[  Read %d character%s from %s: "%s"\n],
+                  $number, ($number == 1) ? ' ' : 's', $FILE, $string;
+    }
+
+    printf qq[  Reset and\n  read 3 characters from $DIGIT: "%s"\n],
+              readN( $DIGIT, 3, 1 );
+}
+
+#------------------------------------------------------------------------------
+sub readN
+#------------------------------------------------------------------------------
+{
+    state %pointers;
+
+    my ($FILE, $number, $reset) = @_;
+
+    $number =~ / ^ $RE{num}{int} $ /x && $number > 0
+        or die "Invalid \$number($number): must be an integer > 0\n";
+
+    if (exists $pointers{ $FILE })
+    {
+        seek( $pointers{ $FILE }, 0, SEEK_SET ) if $reset;
+    }
+    else
+    {
+        open( my $fh, '<', $FILE )
+            or die qq[Can't open file "$FILE" for reading, stopped];
+
+        $pointers{ $FILE } = $fh;
+    }
+
+    my $fh   = $pointers{ $FILE };
+    my $text = '';
+
+    for (1 .. $number)
+    {
+        if (defined( my $char = getc $fh ))
+        {
+            $text .= $char;
+        }
+        else
+        {
+            last;
+        }
+    }
+
+    return $text;
+}
+
+###############################################################################
diff --git a/challenge-098/athanasius/perl/ch-2.pl b/challenge-098/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..67f8c0f713
--- /dev/null
+++ b/challenge-098/athanasius/perl/ch-2.pl
@@ -0,0 +1,150 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 098
+=========================
+
+Task #2
+-------
+*Search Insert Position*
+
+Submitted by: Mohammad S Anwar
+
+You are given a sorted array of distinct integers @N and a target $N.
+
+Write a script to return the index of the given target if found otherwise place
+the target in the sorted array and return the index.
+
+Example 1:
+
+ Input: @N = (1, 2, 3, 4) and $N = 3
+ Output: 2 since the target 3 is in the array at the index 2.
+
+Example 2:
+
+ Input: @N = (1, 3, 5, 7) and $N = 6
+ Output: 3 since the target 6 is missing and should be placed at the index 3.
+
+Example 3:
+
+ Input: @N = (12, 14, 16, 18) and $N = 10
+ Output: 0 since the target 10 is missing and should be placed at the index 0.
+
+Example 4:
+
+ Input: @N = (11, 13, 15, 17) and $N = 19
+ Output: 4 since the target 19 is missing and should be placed at the index 4.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+The index search is implemented using the List::MoreUtils first_index() sub-
+routine. Note that first_index() "Returns -1 if no such item could be found",
+which happens only when $N comes after the last list element. In this case, the
+required index is one greater than the currently-highest list index.
+
+Note: The Task description specifies:
+
+    "Write a script to return the index of the given target if found otherwise
+     place the target in the sorted array and return the index."
+
+However, as the output required is the index only, there seems no point in
+actually *inserting* $N into the array in the case where $N does not already
+occur in @N. I interpret the Task description to mean "otherwise return the
+index which $N would have if inserted into @N."
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use List::MoreUtils qw( first_index );
+use Regexp::Common  qw( number );
+
+const my $VERBOSE => 1;
+const my $USAGE   =>
+"Usage:
+  perl $0 [-N=<Int>] [<N> ...]
+
+    -N=<Int>     The target integer
+    [<N> ...]    A sorted list of distinct integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 098, Task #2: Search Insert Position (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($N, @N) = parse_command_line();
+
+    printf "Input:  \@N = (%s) and \$N = %d\n", join(', ', @N), $N;
+
+    my $msg = 'in the array';
+    my $idx = first_index { $_ == $N } @N;
+
+    if ($idx < 0)
+    {
+        $msg = 'missing and should be placed';
+        $idx = first_index { $_ > $N } @N;
+        $idx = $#N + 1 if $idx < 0;
+    }
+
+    printf "Output: $idx%s\n",
+            $VERBOSE ? " since the target $N is $msg at the index $idx" : '';
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $N;
+
+    GetOptions( 'N=i' => \$N ) or error( 'Invalid command-line argument' );
+    defined $N                 or error( '$N is missing' );
+
+    my @array = @ARGV;
+
+    if (scalar @array > 0)
+    {
+        my $prev = $array[ 0 ];
+
+        for my $i (1 .. $#array)
+        {
+            my $curr = $array[ $i ];
+
+            $prev == $curr and error( 'The list elements are not distinct' );
+            $prev >  $curr and error( 'The list is not correctly sorted'   );
+            $prev =  $curr;
+        }
+    }
+
+    return ($N, @array);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-098/athanasius/perl/digit.txt b/challenge-098/athanasius/perl/digit.txt
new file mode 100644
index 0000000000..6a537b5b36
--- /dev/null
+++ b/challenge-098/athanasius/perl/digit.txt
@@ -0,0 +1 @@
+1234567890
\ No newline at end of file
diff --git a/challenge-098/athanasius/raku/alpha.txt b/challenge-098/athanasius/raku/alpha.txt
new file mode 100644
index 0000000000..e85d5b4528
--- /dev/null
+++ b/challenge-098/athanasius/raku/alpha.txt
@@ -0,0 +1 @@
+abcdefghijklmnopqrstuvwxyz
\ No newline at end of file
diff --git a/challenge-098/athanasius/raku/ch-1.raku b/challenge-098/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..00917a68f1
--- /dev/null
+++ b/challenge-098/athanasius/raku/ch-1.raku
@@ -0,0 +1,140 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 098
+=========================
+
+Task #1
+-------
+*Read N-characters*
+
+Submitted by: Mohammad S Anwar
+
+You are given file $FILE.
+
+Create subroutine readN($FILE, $number) returns the first n-characters and
+moves the pointer to the (n+1)th character.
+
+Example:
+
+ Input: Suppose the file (input.txt) contains "1234567890"
+ Output:
+     print readN("input.txt", 4); # returns "1234"
+     print readN("input.txt", 4); # returns "5678"
+     print readN("input.txt", 4); # returns "90"
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+The subroutine readN()'s parameter $FILE is a file *name*. In Raku, an IO::
+Handle object contains an in-built pointer to the next character in the file.
+So, the implementation of readN() given below uses a local, persistent hash to
+match file names to their corresponding handles; the remaining bookkeeping for
+the file pointer is then performed "under the hood" by Raku itself.
+
+The MAIN subroutine demonstrates readN()'s functionality using two small files:
+'digit.txt' contains the digits 1 to 9 and 0 as in the Example, and 'alpha.txt'
+contains the lowercase letters a to z. MAIN calls readN() ten times with alter-
+nating filenames and assorted values of $number to show that:
+  -- calls with different filenames are handled independently of each other
+  -- readN() "remembers" the position of the next character from one call to
+     another
+  -- once the file is exhausted, calls to readN() return the empty string.
+
+To be useful in practice, the readN() subroutine should also have a reset
+facility. This is provided via a third, optional parameter to readN().
+
+=end comment
+#==============================================================================
+
+my Str constant $DIGIT = 'digit.txt';
+my Str constant $ALPHA = 'alpha.txt';
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 098, Task #1: Read N-characters (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+      'Input:'.put;
+    qq[  File "%s" contains "%s"\n].printf: $DIGIT, $DIGIT.IO.slurp;
+    qq[  File "%s" contains "%s"\n].printf: $ALPHA, $ALPHA.IO.slurp;
+    "\nOutput:".put;
+
+    for $DIGIT => 4, $ALPHA => 5, $DIGIT => 3, $ALPHA => 3, $DIGIT => 1,
+        $ALPHA => 4, $DIGIT => 7, $ALPHA => 4, $DIGIT => 2
+    {
+        my $string = readN( .key, .value );
+
+        qq[  Read %d character%s from %s: "%s"\n].printf:
+            .value, (.value == 1) ?? ' ' !! 's', .key, $string;
+    }
+
+    qq[  Reset and\n  read 3 characters from $DIGIT: "%s"\n].printf:
+        readN( $DIGIT, 3, True );
+}
+
+#------------------------------------------------------------------------------
+sub readN
+(
+    Str:D  $FILE,                   #= Filename
+    UInt:D $number where * > 0,     #= Number of characters to read
+    Bool:D $reset = False,          #= Reset file pointer to beginning of file?
+--> Str:D                           #= The characters read (if any)
+)
+#------------------------------------------------------------------------------
+{
+    state IO::Handle %pointers;
+    my    IO::Handle $pointer = %pointers{ $FILE };
+
+    if $pointer.defined
+    {
+        $pointer.seek( 0, SeekFromBeginning ) if $reset;
+    }
+    else
+    {
+        $pointer = %pointers{ $FILE } = $FILE.IO.open;
+    }
+
+    my Str $text = '';
+
+    for 1 .. $number
+    {
+        if (my Str $char = $pointer.getc).defined
+        {
+            $text ~= $char;
+        }
+        else
+        {
+            last;
+        }
+    }
+
+    return $text;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-098/athanasius/raku/ch-2.raku b/challenge-098/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..31703df45c
--- /dev/null
+++ b/challenge-098/athanasius/raku/ch-2.raku
@@ -0,0 +1,135 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 098
+=========================
+
+Task #2
+-------
+*Search Insert Position*
+
+Submitted by: Mohammad S Anwar
+
+You are given a sorted array of distinct integers @N and a target $N.
+
+Write a script to return the index of the given target if found otherwise place
+the target in the sorted array and return the index.
+
+Example 1:
+
+ Input: @N = (1, 2, 3, 4) and $N = 3
+ Output: 2 since the target 3 is in the array at the index 2.
+
+Example 2:
+
+ Input: @N = (1, 3, 5, 7) and $N = 6
+ Output: 3 since the target 6 is missing and should be placed at the index 3.
+
+Example 3:
+
+ Input: @N = (12, 14, 16, 18) and $N = 10
+ Output: 0 since the target 10 is missing and should be placed at the index 0.
+
+Example 4:
+
+ Input: @N = (11, 13, 15, 17) and $N = 19
+ Output: 4 since the target 19 is missing and should be placed at the index 4.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+The index search is implemented using Raku's built-in List::first() method with
+the named parameter :k. Note that first() "returns Nil when no values match",
+which happens only when $N comes after the last list element. To handle this
+case, the returned index is tested for definedness: an undefined value is re-
+placed with the index one greater than the currently-highest list index.
+
+Note: The Task description specifies:
+
+    "Write a script to return the index of the given target if found otherwise
+     place the target in the sorted array and return the index."
+
+However, as the output required is the index only, there seems no point in
+actually *inserting* $N into the array in the case where $N does not already
+occur in @N. I interpret the Task description to mean "otherwise return the
+index which $N would have if inserted into @N."
+
+=end comment
+#==============================================================================
+
+my Bool constant $VERBOSE = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 098, Task #2: Search Insert Position (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Int:D :$N,     #= The target integer
+
+    #| A sorted list of distinct integers
+
+    *@N where { .all ~~ Int:D && distinct-and-ordered( @N ) }
+)
+#==============================================================================
+{
+    "Input:  @N = (%s) and \$N = %d\n".printf: @N.join(', '), $N;
+
+    my Str  $msg = 'in the array';
+    my UInt $idx = @N.first( * == $N, :k );
+
+    unless $idx.defined
+    {
+        $msg = 'missing and should be placed';
+        $idx = @N.first( * > $N, :k ) // @N.end + 1;
+    }
+
+    "Output: $idx%s\n".printf:
+        $VERBOSE ?? " since the target $N is $msg at the index $idx" !! '';
+}
+
+#------------------------------------------------------------------------------
+sub distinct-and-ordered( Array:D[Int:D] $array --> Bool )
+#------------------------------------------------------------------------------
+{
+    if $array.elems > 0
+    {
+        my Int $previous = $array[ 0 ];
+
+        for 1 .. $array.end -> Int $i
+        {
+            my Int $current = $array[ $i ];
+
+            return False if $previous >= $current;
+
+            $previous = $current;
+        }
+    }
+
+    return True;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-098/athanasius/raku/digit.txt b/challenge-098/athanasius/raku/digit.txt
new file mode 100644
index 0000000000..6a537b5b36
--- /dev/null
+++ b/challenge-098/athanasius/raku/digit.txt
@@ -0,0 +1 @@
+1234567890
\ No newline at end of file