Merge pull request #10267 from PerlMonk-Athanasius/branch-for-challenge-273

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

4 files changed, 739 insertions, 0 deletions

diff --git a/challenge-273/athanasius/perl/ch-1.pl b/challenge-273/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..61d41b64b7
--- /dev/null
+++ b/challenge-273/athanasius/perl/ch-1.pl
@@ -0,0 +1,212 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 273
+=========================
+
+TASK #1
+-------
+*Percentage of Character*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str and a character $char.
+
+Write a script to return the percentage, nearest whole, of given character in
+the given string.
+
+Example 1
+
+  Input: $str = "perl", $char = "e"
+  Output: 25
+
+Example 2
+
+  Input: $str = "java", $char = "a"
+  Output: 50
+
+Example 3
+
+  Input: $str = "python", $char = "m"
+  Output: 0
+
+Example 4
+
+  Input: $str = "ada", $char = "a"
+  Output: 67
+
+Example 5
+
+  Input: $str = "ballerina", $char = "l"
+  Output: 22
+
+Example 6
+
+  Input: $str = "analitik", $char = "k"
+  Output: 13
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The input string and character are entered as unnamed (positional) arguments
+   on the command-line.
+3. If "--ignore-case" is entered on the command-line, "X" and "x" (for example)
+   are treated as the same character; otherwise, the default behaviour is to
+   treat them as different characters.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [--ignore-case] <str> <char>
+  perl $0
+
+    <str>            A string
+    <char>           A character
+    --ignore-case    "X" and "x" are the same character [default: False]
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 273, Task #1: Percentage of Character (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($str, $char, $ignore_case) = parse_command_line();
+
+        print qq[Input:  \$str = "$str", \$char = "$char"\n];
+
+        my $percent = find_percentage( $str, $char, $ignore_case );
+
+        print "Output: $percent\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_percentage
+#-------------------------------------------------------------------------------
+{
+    my ($str, $orig_char, $ignore_case) = @_;
+
+    return 0 if length $str == 0;                       # Avoid division by zero
+
+    my $count = 0;
+    my $char  = $ignore_case ? lc $orig_char : $orig_char;
+
+    for my $orig_c (split //, $str)
+    {
+        my $c = $ignore_case ? lc $orig_c    : $orig_c;
+
+        ++$count if $c eq $char;
+    }
+
+    return int( (($count / length $str) * 100) + 0.5 );
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $ignore_case;
+
+    GetOptions
+    (
+        'ignore-case' => \$ignore_case
+
+    )   or error( 'Invalid command-line argument(s)' );
+
+    my $argc = scalar @ARGV;
+
+    $argc == 2
+        or error( "Expected 0, 2, or 3 command-line arguments, found $argc" );
+
+    my ($str, $char) = @ARGV;
+
+    length $char == 1
+        or error( qq[Invalid char "$char"] );
+
+    return ($str, $char, $ignore_case);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str, $char, $ignore_case, $expected) =
+             split / \| /x, $line;
+
+        for ($test_name, $str, $char, $ignore_case, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $percent = find_percentage( $str, $char, $ignore_case );
+
+        ok $percent == $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1    |perl     |e|0| 25
+Example 2    |java     |a|0| 50
+Example 3    |python   |m|0|  0
+Example 4    |ada      |a|0| 67
+Example 5    |ballerina|l|0| 22
+Example 6    |analitik |k|0| 13
+Empty string |         |a|0|  0
+Same chars   |jjjjj    |j|0|100
+Ignore case 1|Aardvark |A|1| 38
+Ignore case 2|Aardvark |a|1| 38
+Use case 1   |Aardvark |A|0| 13
+Use case 2   |Aardvark |a|0| 25
diff --git a/challenge-273/athanasius/perl/ch-2.pl b/challenge-273/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..66b03f9a93
--- /dev/null
+++ b/challenge-273/athanasius/perl/ch-2.pl
@@ -0,0 +1,166 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 273
+=========================
+
+TASK #2
+-------
+*B After A*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str.
+
+Write a script to return true if there is at least one b, and no a appears after
+the first b.
+
+Example 1
+
+  Input: $str = "aabb"
+  Output: true
+
+Example 2
+
+  Input: $str = "abab"
+  Output: false
+
+Example 3
+
+  Input: $str = "aaa"
+  Output: false
+
+Example 4
+
+  Input: $str = "bbb"
+  Output: true
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+Character comparisons are NOT case-sensitive; i.e., "A" is the same character as
+"a", and "B" is the same character as "b".
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The input string is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <str>
+  perl $0
+
+    <str>    A string
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 273, Task #2: B After A (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $str = $ARGV[ 0 ];
+
+        print qq[Input:  \$str = "$str"\n];
+
+        my $b_after_a = b_after_a( $str );
+
+        printf "Output: %s\n", $b_after_a ? 'true' : 'false';
+    }
+    else
+    {
+        error( "Expected 0 or 1 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub b_after_a
+#-------------------------------------------------------------------------------
+{
+    my ($str) = @_;
+
+    return $str =~ / ^ [^b]* b [^a]* $ /ix;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $b_after_a = b_after_a( $str ) ? 'true' : 'false';
+
+        is $b_after_a, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1  |aabb |true
+Example 2  |abab |false
+Example 3  |aaa  |false
+Example 4  |bbb  |true
+Uppercase 1|AABB |true
+Uppercase 2|aBAb |false
+Uppercase 3|aAa  |false
+Uppercase 4|Bbb  |true
+First B    |ababx|false
+Second B   |abxba|false
diff --git a/challenge-273/athanasius/raku/ch-1.raku b/challenge-273/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..a022c9fe61
--- /dev/null
+++ b/challenge-273/athanasius/raku/ch-1.raku
@@ -0,0 +1,197 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 273
+=========================
+
+TASK #1
+-------
+*Percentage of Character*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str and a character $char.
+
+Write a script to return the percentage, nearest whole, of given character in
+the given string.
+
+Example 1
+
+  Input: $str = "perl", $char = "e"
+  Output: 25
+
+Example 2
+
+  Input: $str = "java", $char = "a"
+  Output: 50
+
+Example 3
+
+  Input: $str = "python", $char = "m"
+  Output: 0
+
+Example 4
+
+  Input: $str = "ada", $char = "a"
+  Output: 67
+
+Example 5
+
+  Input: $str = "ballerina", $char = "l"
+  Output: 22
+
+Example 6
+
+  Input: $str = "analitik", $char = "k"
+  Output: 13
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The input string and character are entered as unnamed (positional) arguments
+   on the command-line.
+3. If "--ignore-case" is entered on the command-line, "X" and "x" (for example)
+   are treated as the same character; otherwise, the default behaviour is to
+   treat them as different characters.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 273, Task #1: Percentage of Character (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D   $str,                          #= A string
+    Str:D   $char where { .chars == 1 },   #= A character
+    Bool:D :$ignore-case = False           #= "X" and "x" are the same character
+)
+#===============================================================================
+{
+    qq[Input:  \$str = "$str", \$char = "$char"].put;
+
+    my UInt $percent = find-percentage( $str, $char, $ignore-case );
+
+    "Output: $percent".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-percentage
+(
+    Str:D  $str,                                                  #= A string
+    Str:D  $orig-char where { .chars == 1 },                      #= A character
+    Bool:D $ignore-case                  #= "X" and "x" are different characters
+--> UInt:D
+)
+#-------------------------------------------------------------------------------
+{
+    return 0 if $str.chars == 0;                        # Avoid division by zero
+
+    my UInt $count = 0;
+    my Str  $char  = $ignore-case ?? $orig-char.lc !! $orig-char;
+
+    for $str.split: '', :skip-empty -> Str $orig-c
+    {
+        my Str $c  = $ignore-case ?? $orig-c.lc    !! $orig-c;
+
+        ++$count if $c eq $char;
+    }
+
+    return (($count / $str.chars) * 100).round;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str, $char, $ignore-case-str, $expected) =
+                $line.split: / \| /;
+
+        for     $test-name, $str, $char, $ignore-case-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Bool $ignore-case = $ignore-case-str eq 'True';
+        my UInt $percent     = find-percentage( $str, $char, $ignore-case );
+
+        ok $percent == $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    |perl     |e|False| 25
+        Example 2    |java     |a|False| 50
+        Example 3    |python   |m|False|  0
+        Example 4    |ada      |a|False| 67
+        Example 5    |ballerina|l|False| 22
+        Example 6    |analitik |k|False| 13
+        Empty string |         |a|False|  0
+        Same chars   |jjjjj    |j|False|100
+        Ignore case 1|Aardvark |A|True | 38
+        Ignore case 2|Aardvark |a|True | 38
+        Use case 1   |Aardvark |A|False| 13
+        Use case 2   |Aardvark |a|False| 25
+        END
+}
+
+################################################################################
diff --git a/challenge-273/athanasius/raku/ch-2.raku b/challenge-273/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..5d80001b7c
--- /dev/null
+++ b/challenge-273/athanasius/raku/ch-2.raku
@@ -0,0 +1,164 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 273
+=========================
+
+TASK #2
+-------
+*B After A*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str.
+
+Write a script to return true if there is at least one b, and no a appears after
+the first b.
+
+Example 1
+
+  Input: $str = "aabb"
+  Output: true
+
+Example 2
+
+  Input: $str = "abab"
+  Output: false
+
+Example 3
+
+  Input: $str = "aaa"
+  Output: false
+
+Example 4
+
+  Input: $str = "bbb"
+  Output: true
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+Character comparisons are NOT case-sensitive; i.e., "A" is the same character as
+"a", and "B" is the same character as "b".
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The input string is entered on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 273, Task #2: B After A (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $str                           #= A string
+)
+#===============================================================================
+{
+    qq[Input:  \$str = "$str"].put;
+
+    my Bool $b-after-a = b-after-a( $str );
+
+    "Output: %s\n".printf: $b-after-a ?? 'true' !! 'false';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub b-after-a( Str:D $str --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    return so $str ~~ m:i/ ^ <-[b]>* b <-[a]>* $ /;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str $b-after-a = b-after-a( $str ) ?? 'true' !! 'false';
+
+        is $b-after-a, $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  |aabb |true
+        Example 2  |abab |false
+        Example 3  |aaa  |false
+        Example 4  |bbb  |true
+        Uppercase 1|AABB |true
+        Uppercase 2|aBAb |false
+        Uppercase 3|aAa  |false
+        Uppercase 4|Bbb  |true
+        First B    |ababx|false
+        Second B   |abxba|false
+        END
+}
+
+################################################################################