Merge pull request #7232 from PerlMonk-Athanasius/branch-for-challenge-194

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

4 files changed, 848 insertions, 0 deletions

diff --git a/challenge-194/athanasius/perl/ch-1.pl b/challenge-194/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..24469aff17
--- /dev/null
+++ b/challenge-194/athanasius/perl/ch-1.pl
@@ -0,0 +1,224 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 194
+=========================
+
+TASK #1
+-------
+*Digital Clock*
+
+Submitted by: Mohammad S Anwar
+
+You are given time in the format hh:mm with one missing digit.
+
+Write a script to find the highest digit between 0-9 that makes it valid time.
+
+Example 1
+
+  Input: $time = '?5:00'
+  Output: 1
+
+  Since 05:00 and 15:00 are valid time and no other digits can fit in the
+  missing place.
+
+Example 2
+
+  Input: $time = '?3:00'
+  Output: 2
+
+Example 3
+
+  Input: $time = '1?:00'
+  Output: 9
+
+Example 4
+
+  Input: $time = '2?:00'
+  Output: 3
+
+Example 5
+
+  Input: $time = '12:?5'
+  Output: 5
+
+Example 6
+
+  Input: $time = '12:5?'
+  Output: 9
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+Algorithm
+---------
+Let the input be symbolized "wx:yz". There are 4 positions in which a digit can
+be replaced by a question mark; each of these positions is treated as a sepa-
+rate case:
+
+  1. ?x:yz - if x is 0, 1, 2, or 3, then the highest value of w is 2; other-
+             wise, it is 1.
+  2. w?:yz - if w is 2, then the highest value of x is 3; otherwise, it is 9.
+  3. wx:?z - the highest possible value of y is always 5.
+  4. wx:y? - the highest possible value of z is always 9.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $TST_FLDS => 3;
+const my $USAGE    =>
+qq[Usage:
+  perl $0 <time>
+  perl $0
+
+    <time>    Time in the format "hh:mm" with one digit replaced by "?"\n];
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 194, Task #1: Digital Clock (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+
+    if    ($args == 0)
+    {
+        run_tests();
+    }
+    elsif ($args == 1)
+    {
+        my $time = parse_command_line();
+
+        print  "Input:  \$time = '$time'\n";
+        printf "Output: %s\n", find_highest_digit( $time );
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $args" );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find_highest_digit
+#------------------------------------------------------------------------------
+{
+    my ($time)       = @_;
+    my  $hour_orig   = substr $time, 0, 2;
+    my  $hour_new    = $hour_orig;
+    my  $minute_orig = substr $time, 3, 2;
+    my  $minute_new  = $minute_orig;
+    my  $digit;
+
+    if    ($hour_orig   =~ / ^ \? (\d) $ /x)                     # Hour:   tens
+    {
+        substr( $hour_new,   0, 1 ) = $digit = ($1 < 4) ? 2 : 1;
+    }
+    elsif ($hour_orig   =~ / ^ (\d) \? $ /x)                     # Hour:   ones
+    {
+        substr( $hour_new,   1, 1 ) = $digit = ($1 < 2) ? 9 : 3;
+    }
+    elsif ($minute_orig =~ / ^ \? /x)                            # Minute: tens
+    {
+        substr( $minute_new, 0, 1 ) = $digit = 5;
+    }
+    else                                                         # Minute: ones
+    {
+        substr( $minute_new, 1, 1 ) = $digit = 9;
+    }
+
+    0 <= $hour_new   < 24 or error( qq[Invalid hour "$hour_orig"]     );
+    0 <= $minute_new < 60 or error( qq[Invalid minute "$minute_orig"] );
+
+    return $digit;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $time = $ARGV[ 0 ];
+
+    length( $time ) == 5
+        or error( 'The input string must be 5 characters long' );
+
+    substr( $time, 2, 1 ) eq ':'
+        or error( 'Hours and minutes must be separated by a colon' );
+
+    my $count = 0;
+
+    for my $i (0, 1, 3, 4)
+    {
+        my $c = substr $time, $i, 1;
+
+        $c =~ /([^0-9?])/
+            and error( qq[Invalid character "$1"] );
+
+        ++$count if $c eq '?';
+    }
+
+    $count == 1
+        or error( 'The input string must contain exactly one question mark' );
+
+    return $time;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $n, $expected) = split / , \s* /x, $line, $TST_FLDS;
+
+        is find_highest_digit( $n ), $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1, ?5:00, 1
+Example 2, ?3:00, 2
+Example 3, 1?:00, 9
+Example 4, 2?:00, 3
+Example 5, 12:?5, 5
+Example 6, 12:5?, 9
diff --git a/challenge-194/athanasius/perl/ch-2.pl b/challenge-194/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..80390430bd
--- /dev/null
+++ b/challenge-194/athanasius/perl/ch-2.pl
@@ -0,0 +1,197 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 194
+=========================
+
+TASK #2
+-------
+*Frequency Equalizer*
+
+Submitted by: Mohammad S Anwar
+
+You are given a string made of alphabetic characters only, a-z.
+
+Write a script to determine whether removing only one character can make the
+frequency of the remaining characters the same.
+
+Example 1:
+
+  Input: $s = 'abbc'
+  Output: 1 since removing one alphabet 'b' will give us 'abc' where each
+          alphabet frequency is the same.
+
+Example 2:
+
+  Input: $s = 'xyzyyxz'
+  Output: 1 since removing 'y' will give us 'xzyyxz'.
+
+Example 3:
+
+  Input: $s = 'xzxz'
+  Output: 0 since removing any one alphabet would not give us string with same
+          frequency alphabet.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run.
+2. To display the character (if any) whose removal can equalize the frequencies
+   of the remaining characters, set $VERBOSE to a true value. (This has no
+   effect on the running of the test suite.)
+
+Corner Cases
+------------
+I assume that the empty string has "all characters the same", so a string of 1
+character satisfies the Task requirement and should give output 1. (Of course,
+the empty string itself has output 0 because it is not possible to remove a
+character from it.)
+
+A string of identical characters (of any number) likewise satisfies the Task
+requirement, because removal of a single character leaves a string of identical
+characters and -- since there is only one distinct character -- this leaves
+"all remaining characters" with the "same" frequency.
+
+The only case in which there is more than one way to satisfy the Task require-
+ment is when the input string consists of exactly two different characters:
+then either character may be removed to leave a single character with a fre-
+quency of 1. In this case I arbitrarily choose to remove the first character.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $TST_FLDS => 3;
+const my $VERBOSE  => 1;
+const my $USAGE    =>
+qq[Usage:
+  perl $0 <s>
+  perl $0
+
+    <s>    A string composed of lower case letters "a" to "z" only\n];
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 194, Task #2: Frequency Equalizer (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+
+    if    ($args == 0)
+    {
+        run_tests();
+    }
+    elsif ($args == 1)
+    {
+        my $s =  $ARGV[ 0 ];
+           $s =~ /([^a-z])/ and error( qq[Invalid character "$1"] );
+
+        print   qq[Input:  \$s = "$s"\n];
+
+        my $char = char2remove( $s );
+
+        printf "Output: %d", $char ? 1 : 0;
+        print   qq[ (remove one letter "$char")] if $VERBOSE && $char;
+        print  "\n";
+    }
+    else
+    {
+        error( "Expected 1 or 0 arguments, found $args" );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub char2remove
+#------------------------------------------------------------------------------
+{
+    my ($s)  = @_;
+    my  $len = length $s;
+
+    return ''                 if $len == 0;
+    return $s                 if $len == 1;
+    return substr( $s, 0, 1 ) if $len == 2;
+
+    my (%char2freq, %freq2char);
+      ++$char2freq{ $_ } for split //, $s;                  # Count frequencies
+
+    while (my ($key, $value) = each %char2freq)             # Reverse the hash
+    {
+        push @{ $freq2char{ $value } }, $key;
+    }
+
+    my @keys   = keys %freq2char;
+    my $n_keys = scalar @keys;
+
+    return @{ $freq2char{ $keys[ 0 ] } }[ 0 ]
+        if $n_keys == 1 && scalar @{ $freq2char{ $keys[ 0 ] } } == 1;
+
+    return '' unless $n_keys == 2;
+
+    my ($low, $high) = sort { $a <=> $b } @keys;
+
+    return '' unless scalar @{ $freq2char{ $high } } == 1;
+
+    return ($high == $low + 1) ? @{ $freq2char{ $high } }[ 0 ] : '';
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $s, $expected) = split / , \s* /x, $line, $TST_FLDS;
+        my  $got = char2remove( $s ) ? 1 : 0;
+
+        is  $got, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1,      abbc,    1
+Example 2,      xyzyyxz, 1
+Example 3,      xzxz,    0
+Empty string,   ,        0
+Single letter,  j,       1
+Same letters 2, dd,      1
+Same letters 5, eeeee,   1
+Distinct pair,  ab,      1
diff --git a/challenge-194/athanasius/raku/ch-1.raku b/challenge-194/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..7bc10c4c6d
--- /dev/null
+++ b/challenge-194/athanasius/raku/ch-1.raku
@@ -0,0 +1,224 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 194
+=========================
+
+TASK #1
+-------
+*Digital Clock*
+
+Submitted by: Mohammad S Anwar
+
+You are given time in the format hh:mm with one missing digit.
+
+Write a script to find the highest digit between 0-9 that makes it valid time.
+
+Example 1
+
+  Input: $time = '?5:00'
+  Output: 1
+
+  Since 05:00 and 15:00 are valid time and no other digits can fit in the
+  missing place.
+
+Example 2
+
+  Input: $time = '?3:00'
+  Output: 2
+
+Example 3
+
+  Input: $time = '1?:00'
+  Output: 9
+
+Example 4
+
+  Input: $time = '2?:00'
+  Output: 3
+
+Example 5
+
+  Input: $time = '12:?5'
+  Output: 5
+
+Example 6
+
+  Input: $time = '12:5?'
+  Output: 9
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+Algorithm
+---------
+Let the input be symbolized "wx:yz". There are 4 positions in which a digit can
+be replaced by a question mark; each of these positions is treated as a sepa-
+rate case:
+
+  1. ?x:yz - if x is 0, 1, 2, or 3, then the highest value of w is 2; other-
+             wise, it is 1.
+  2. w?:yz - if w is 2, then the highest value of x is 3; otherwise, it is 9.
+  3. wx:?z - the highest possible value of y is always 5.
+  4. wx:y? - the highest possible value of z is always 9.
+
+=end comment
+#==============================================================================
+
+use Test;
+
+subset Digit of Int where 0 <= * <= 9;
+
+my UInt constant $TEST-FIELDS = 3;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 194, Task #1: Digital Clock (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    #| Time in the format "hh:mm" with one digit replaced by "?"
+
+    Str:D $time where input-is-valid( $_ )
+)
+#==============================================================================
+{
+    "Input:  \$time = '$time'".put;
+
+    my Digit $hd = find-highest-digit( $time );
+
+    "Output: $hd".put;
+}
+
+#==============================================================================
+multi sub MAIN()                                 # No input: run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub find-highest-digit( Str:D $time --> Digit:D )
+#------------------------------------------------------------------------------
+{
+    my Str   $hour-orig   = $time.substr: 0, 2;
+    my Str   $hour-new    = $hour-orig;
+    my Str   $minute-orig = $time.substr: 3, 2;
+    my Str   $minute-new  = $minute-orig;
+    my Digit $digit;
+
+    if    $hour-orig   ~~ / ^ \? (\d) $ /                        # Hour:   tens
+    {
+        $hour-new.substr-rw( 0, 1 )   = $digit = ($0.Int < 4) ?? 2 !! 1;
+    }
+    elsif $hour-orig   ~~ / ^ (\d) \? $ /                        # Hour:   ones
+    {
+        $hour-new.substr-rw( 1, 1 )   = $digit = ($0.Int < 2) ?? 9 !! 3;
+    }
+    elsif $minute-orig ~~ / ^ \? /                               # Minute: tens
+    {
+        $minute-new.substr-rw( 0, 1 ) = $digit = 5;
+    }
+    else                                                         # Minute: ones
+    {
+        $minute-new.substr-rw( 1, 1 ) = $digit = 9;
+    }
+
+    0 <= $hour-new\ .Int < 24 or error( qq[Invalid hour "$hour-orig"]     );
+    0 <= $minute-new.Int < 60 or error( qq[Invalid minute "$minute-orig"] );
+
+    return $digit;
+}
+
+#------------------------------------------------------------------------------
+sub input-is-valid( Str:D $time --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    return False unless $time.chars == 5;
+    return False unless $time.substr( 2, 1 ) eq ':';
+
+    my UInt $count = 0;
+
+    for 0, 1, 3, 4 -> UInt $i
+    {
+        my Str $c = $time.substr: $i, 1;
+
+        return False unless $c ~~ / ^ <[ 0..9 ? ]> $ /;
+
+        ++$count if $c eq '?';
+    }
+
+    return $count == 1;
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $time, $expected) =
+                $line.split: / \, \s* /, $TEST-FIELDS, :skip-empty;
+
+        is find-highest-digit( $time ), $expected, $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, ?5:00, 1
+        Example 2, ?3:00, 2
+        Example 3, 1?:00, 9
+        Example 4, 2?:00, 3
+        Example 5, 12:?5, 5
+        Example 6, 12:5?, 9
+        END
+}
+
+###############################################################################
diff --git a/challenge-194/athanasius/raku/ch-2.raku b/challenge-194/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..760202623e
--- /dev/null
+++ b/challenge-194/athanasius/raku/ch-2.raku
@@ -0,0 +1,203 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 194
+=========================
+
+TASK #2
+-------
+*Frequency Equalizer*
+
+Submitted by: Mohammad S Anwar
+
+You are given a string made of alphabetic characters only, a-z.
+
+Write a script to determine whether removing only one character can make the
+frequency of the remaining characters the same.
+
+Example 1:
+
+  Input: $s = 'abbc'
+  Output: 1 since removing one alphabet 'b' will give us 'abc' where each
+          alphabet frequency is the same.
+
+Example 2:
+
+  Input: $s = 'xyzyyxz'
+  Output: 1 since removing 'y' will give us 'xzyyxz'.
+
+Example 3:
+
+  Input: $s = 'xzxz'
+  Output: 0 since removing any one alphabet would not give us string with same
+          frequency alphabet.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run.
+2. To display the character (if any) whose removal can equalize the frequencies
+   of the remaining characters, set $VERBOSE to True. (This has no effect on
+   the running of the test suite.)
+
+Corner Cases
+------------
+I assume that the empty string has "all characters the same", so a string of 1
+character satisfies the Task requirement and should give output 1. (Of course,
+the empty string itself has output 0 because it is not possible to remove a
+character from it.)
+
+A string of identical characters (of any number) likewise satisfies the Task
+requirement, because removal of a single character leaves a string of identical
+characters and -- since there is only one distinct character -- this leaves
+"all remaining characters" with the "same" frequency.
+
+The only case in which there is more than one way to satisfy the Task require-
+ment is when the input string consists of exactly two different characters:
+then either character may be removed to leave a single character with a fre-
+quency of 1. In this case I arbitrarily choose to remove the first character.
+
+=end comment
+#==============================================================================
+
+use Test;
+
+subset S-type of Str where * ~~ / ^ <[ a .. z ]>* $ /;
+
+my UInt constant $TST-FLDS = 3;
+my Bool constant $VERBOSE  = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 194, Task #2: Frequency Equalizer (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    S-type:D $s      #= A string composed of lower case letters "a" to "z" only
+)
+#==============================================================================
+{
+    qq[Input:  \$s = "$s"].put;
+
+    my Str $char = char2remove( $s );
+
+    "Output: %d".printf: $char ?? 1 !! 0;
+    qq[ (remove one letter "$char")].print if $VERBOSE && $char;
+    put();
+}
+
+#==============================================================================
+multi sub MAIN()                                           # Run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub char2remove( S-type:D $s --> Str:D )
+#------------------------------------------------------------------------------
+{
+    my UInt $len = $s.chars;
+
+    return ''                if $len == 0;
+    return $s                if $len == 1;
+    return $s.substr( 0, 1 ) if $len == 2;
+
+    my UInt %char2freq{Str};                                # Count frequencies
+          ++%char2freq{ $_ } for $s.split: '', :skip-empty;
+
+    my Array[Str] %freq2char{UInt};
+
+    for %char2freq.kv -> Str $key, UInt $value              # Reverse the hash
+    {
+        %freq2char{ $value }.push: $key;
+    }
+
+    my UInt @keys   = %freq2char.keys;
+    my UInt $n-keys = @keys.elems;
+
+    return %freq2char{ @keys[ 0 ] }[ 0 ]
+        if $n-keys == 1 && %freq2char{ @keys[ 0 ] }.elems == 1;
+
+    return '' unless $n-keys == 2;
+
+    my UInt ($low, $high) = @keys.sort;
+
+    return '' unless %freq2char{ $high }.elems == 1;
+
+    return ($high == $low + 1) ?? %freq2char{ $high }[ 0 ] !! '';
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $s, $expected) =
+            $line.split: / \, \s* /, $TST-FLDS;
+
+        my UInt $got = char2remove( $s ) ?? 1 !! 0;
+
+        is $got, $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,      abbc,    1
+        Example 2,      xyzyyxz, 1
+        Example 3,      xzxz,    0
+        Empty string,   ,        0
+        Single letter,  j,       1
+        Same letters 2, dd,      1
+        Same letters 5, eeeee,   1
+        Distinct pair,  ab,      1
+        END
+}
+
+###############################################################################