Merge pull request #10686 from PerlMonk-Athanasius/branch-for-challenge-283

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

4 files changed, 683 insertions, 0 deletions

diff --git a/challenge-283/athanasius/perl/ch-1.pl b/challenge-283/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..a7791b781d
--- /dev/null
+++ b/challenge-283/athanasius/perl/ch-1.pl
@@ -0,0 +1,173 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 283
+=========================
+
+TASK #1
+-------
+*Unique Number*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints, where every elements appears more
+than once except one element.
+
+Write a script to find the one element that appears exactly one time.
+
+Example 1
+
+  Input: @ints = (3, 3, 1)
+  Output: 1
+
+Example 2
+
+  Input: @ints = (3, 2, 4, 2, 4)
+  Output: 3
+
+Example 3
+
+  Input: @ints = (1)
+  Output: 1
+
+Example 4
+
+  Input: @ints = (4, 3, 1, 1, 1, 4)
+  Output: 3
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A list of integers is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    List of integers in which exactly 1 int appears exactly once
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 283, Task #1: Unique Number (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @ints = @ARGV;
+
+        for (@ints)
+        {
+            / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+
+            $_ += 0;                          # Normalize (e.g., change -0 to 0)
+        }
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @ints;
+
+        my $unique_num = find_unique_num( \@ints );
+
+        if (defined $unique_num)
+        {
+            print "Output: $unique_num\n";
+        }
+        else
+        {
+            print "\n";
+            error( 'The input list is invalid' );
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_unique_num
+#-------------------------------------------------------------------------------
+{
+    my ($ints) = @_;
+    my  %count;
+
+    ++$count{ $_ } for @$ints;
+
+    my @singletons = grep { $count{ $_ } == 1 } keys %count;
+
+    return scalar @singletons == 1 ? $singletons[ 0 ] : undef;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints       = split / \s+ /x, $ints_str;
+        my $unique_num = find_unique_num( \@ints );
+
+        defined $unique_num or die( 'Invalid test data' );
+
+        is $unique_num, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|3 3 1      |1
+Example 2|3 2 4 2 4  |3
+Example 3|1          |1
+Example 4|4 3 1 1 1 4|3
diff --git a/challenge-283/athanasius/perl/ch-2.pl b/challenge-283/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..8600c259f1
--- /dev/null
+++ b/challenge-283/athanasius/perl/ch-2.pl
@@ -0,0 +1,172 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 283
+=========================
+
+TASK #2
+-------
+*Digit Count Value*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of positive integers, @ints.
+
+Write a script to return true if for every index i in the range 0 <= i < size of
+array, the digit i occurs exactly the $ints[$i] times in the given array other-
+wise return false.
+
+Example 1
+
+  Input: @ints = (1, 2, 1, 0)
+  Output: true
+
+  $ints[0] = 1, the digit 0 occurs exactly 1 time.
+  $ints[1] = 2, the digit 1 occurs exactly 2 times.
+  $ints[2] = 1, the digit 2 occurs exactly 1 time.
+  $ints[3] = 0, the digit 3 occurs 0 time.
+
+Example 2
+
+  Input: @ints = (0, 3, 0)
+  Output: false
+
+  $ints[0] = 0, the digit 0 occurs 2 times rather than 0 time.
+  $ints[1] = 3, the digit 1 occurs 0 time rather than 3 times.
+  $ints[2] = 0, the digit 2 occurs exactly 0 time.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A list of positive integers is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures and warnings
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A list of positive integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 283, Task #2: Digit Count Value (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @ints = @ARGV;
+
+        for (@ints)
+        {
+            / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+            $_ >= 0                or error( "$_ is negative");
+            $_ += 0;                          # Normalize (e.g., change +1 to 1)
+        }
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @ints;
+
+        my $match = indices_match_freqs( \@ints );
+
+        printf "Output: %s\n", $match ? 'true' : 'false';
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub indices_match_freqs
+#-------------------------------------------------------------------------------
+{
+    my ($ints) = @_;
+    my  %count;
+
+    ++$count{ $_ } for @$ints;
+
+    for my $i (0 .. $#$ints)
+    {
+        my $value = $ints->[ $i ];
+
+        if ($value == 0)
+        {
+            return 0 if exists $count{ $i };
+        }
+        else
+        {
+            return 0 if $count{ $i } != $value;
+        }
+    }
+
+    return 1;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints  = split / \s+ /x, $ints_str;
+        my $match = indices_match_freqs( \@ints ) ? 'true' : 'false';
+
+        is $match, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|1 2 1 0|true
+Example 2|0 3 0  |false
diff --git a/challenge-283/athanasius/raku/ch-1.raku b/challenge-283/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..4dca71e315
--- /dev/null
+++ b/challenge-283/athanasius/raku/ch-1.raku
@@ -0,0 +1,177 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 283
+=========================
+
+TASK #1
+-------
+*Unique Number*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints, where every elements appears more
+than once except one element.
+
+Write a script to find the one element that appears exactly one time.
+
+Example 1
+
+  Input: @ints = (3, 3, 1)
+  Output: 1
+
+Example 2
+
+  Input: @ints = (3, 2, 4, 2, 4)
+  Output: 3
+
+Example 3
+
+  Input: @ints = (1)
+  Output: 1
+
+Example 4
+
+  Input: @ints = (4, 3, 1, 1, 1, 4)
+  Output: 3
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A list of integers is entered on the command-line.
+3. If the first integer is negative, it must be preceded by "--" to indicate
+   that it is not a command-line flag.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 283, Task #1: Unique Number (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| List of integers in which exactly 1 int appears exactly once
+
+    *@ints where { .elems > 0 && .all ~~ Int:D }
+)
+#===============================================================================
+{
+    my Int @ints_ = @ints;             # Make a copy, then
+           @ints_.map: { $_ += 0 };    # Normalize the elements (e.g., -0 --> 0)
+
+    "Input:  \@ints = (%s)\n".printf: @ints_.join: ', ';
+
+    my Int $unique-num = find-unique-num( @ints_ );
+
+    if $unique-num.defined
+    {
+        "Output: $unique-num".put;
+    }
+    else
+    {
+        put();
+        error( 'The input list is invalid' );
+    }
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-unique-num( List:D[Int:D] $ints --> Int:_ )
+#-------------------------------------------------------------------------------
+{
+    my UInt %count{Int};
+
+    ++%count{ $_ } for @$ints;
+
+    my Int @singletons = %count.keys.grep: { %count{ $_ } == 1 };
+
+    return @singletons.elems == 1 ?? @singletons[ 0 ] !! Nil;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $ints-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @ints       = $ints-str.split( / \s+ / ).map: { .Int };
+        my Int $unique-num = find-unique-num( @ints );
+
+        $unique-num.defined or die( 'Invalid test data' );
+
+        is $unique-num, $expected.Int, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error( Str:D $message )
+#-------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#-------------------------------------------------------------------------------
+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|3 3 1      |1
+        Example 2|3 2 4 2 4  |3
+        Example 3|1          |1
+        Example 4|4 3 1 1 1 4|3
+        END
+}
+
+################################################################################
diff --git a/challenge-283/athanasius/raku/ch-2.raku b/challenge-283/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..c73d1d9402
--- /dev/null
+++ b/challenge-283/athanasius/raku/ch-2.raku
@@ -0,0 +1,161 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 283
+=========================
+
+TASK #2
+-------
+*Digit Count Value*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of positive integers, @ints.
+
+Write a script to return true if for every index i in the range 0 <= i < size of
+array, the digit i occurs exactly the $ints[$i] times in the given array other-
+wise return false.
+
+Example 1
+
+  Input: @ints = (1, 2, 1, 0)
+  Output: true
+
+  $ints[0] = 1, the digit 0 occurs exactly 1 time.
+  $ints[1] = 2, the digit 1 occurs exactly 2 times.
+  $ints[2] = 1, the digit 2 occurs exactly 1 time.
+  $ints[3] = 0, the digit 3 occurs 0 time.
+
+Example 2
+
+  Input: @ints = (0, 3, 0)
+  Output: false
+
+  $ints[0] = 0, the digit 0 occurs 2 times rather than 0 time.
+  $ints[1] = 3, the digit 1 occurs 0 time rather than 3 times.
+  $ints[2] = 0, the digit 2 occurs exactly 0 time.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A list of positive integers is entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 283, Task #2: Digit Count Value (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    *@ints where { .elems > 0 && .all ~~ UInt:D } #= A list of positive integers
+)
+#===============================================================================
+{
+    my UInt @ints_ = @ints.map: { .Int };         # Turn IntStr's back into Ints
+
+    "Input:  \@ints = (%s)\n".printf: @ints_.join: ', ';
+
+    my Bool $match = indices-match-freqs( @ints_ );
+
+    "Output: %s\n".printf: $match ?? 'true' !! 'false';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub indices-match-freqs( List:D[UInt:D] $ints --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt %count{UInt};
+
+    ++%count{ $_ } for @$ints;
+
+    for 0 .. $ints.end -> UInt $i
+    {
+        my UInt $value = $ints[ $i ];
+
+        if $value == 0
+        {
+            return False if %count{ $i }:exists;
+        }
+        else
+        {
+            return False if %count{ $i } !== $value;
+        }
+    }
+
+    return True;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $ints-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt @ints  = $ints-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my Str  $match = indices-match-freqs( @ints ) ?? 'true' !! 'false';
+
+        is $match, $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 1 0|true
+        Example 2|0 3 0  |false
+        END
+}
+
+################################################################################