aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMohammad Sajid Anwar <Mohammad.Anwar@yahoo.com>2025-07-05 10:55:45 +0100
committerGitHub <noreply@github.com>2025-07-05 10:55:45 +0100
commit8ad5602e13afee433b4835beaba80fc00299e02b (patch)
tree66a80270836832fa13b3f0642af43efb438e805b
parenta32754f967c1008da6aca4871d9bfe97067230f1 (diff)
parent9df16ca67e65d7bb16b4bfbc873d570e913f8834 (diff)
downloadperlweeklychallenge-club-8ad5602e13afee433b4835beaba80fc00299e02b.tar.gz
perlweeklychallenge-club-8ad5602e13afee433b4835beaba80fc00299e02b.tar.bz2
perlweeklychallenge-club-8ad5602e13afee433b4835beaba80fc00299e02b.zip
Merge pull request #12285 from PerlMonk-Athanasius/branch-for-challenge-328
Perl & Raku solutions to Tasks 1 & 2 for Week 328
-rw-r--r--challenge-328/athanasius/perl/ch-1.pl182
-rw-r--r--challenge-328/athanasius/perl/ch-2.pl178
-rw-r--r--challenge-328/athanasius/raku/ch-1.raku179
-rw-r--r--challenge-328/athanasius/raku/ch-2.raku170
4 files changed, 709 insertions, 0 deletions
diff --git a/challenge-328/athanasius/perl/ch-1.pl b/challenge-328/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..441372fd4b
--- /dev/null
+++ b/challenge-328/athanasius/perl/ch-1.pl
@@ -0,0 +1,182 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 328
+=========================
+
+TASK #1
+-------
+*Replace all ?*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing only lower case English letters and ?.
+
+Write a script to replace all ? in the given string so that the string doesn’t
+contain consecutive repeating characters.
+
+Example 1
+
+ Input: $str = "a?z"
+ Output: "abz"
+
+ There can be many strings, one of them is "abz".
+ The choices are 'a' to 'z' but we can't use either 'a' or 'z' to replace the
+ '?'.
+
+Example 2
+
+ Input: $str = "pe?k"
+ Output: "peak"
+
+Example 3
+
+ Input: $str = "gra?te"
+ Output: "grabte"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string containing only lower case English letters and "?" is entered on the
+ command-line.
+
+=cut
+#===============================================================================
+
+use v5.32; # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+ perl $0 <str>
+ perl $0
+
+ <str> A string containing only lower case English letters and "?"
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ $| = 1;
+ print "\nChallenge 328, Task #1: Replace all ? (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+ my $argc = scalar @ARGV;
+
+ if ($argc == 0)
+ {
+ run_tests();
+ }
+ elsif ($argc == 1)
+ {
+ my $str = $ARGV[ 0 ];
+
+ $str =~ / ^ [a-z?]* $ /x or error( 'Invalid string' );
+
+ print qq[Input: \$str = "$str"\n];
+
+ my $replaced = replace_queries( $str );
+
+ print qq[Output: "$replaced"\n];
+ }
+ else
+ {
+ error( "Expected 1 or 0 command-line arguments, found $argc" );
+ }
+}
+
+#-------------------------------------------------------------------------------
+sub replace_queries
+#-------------------------------------------------------------------------------
+{
+ my ($str) = @_;
+ $str =~ / ^ [a-z?]* $ /x or die 'Invalid string';
+
+ my $replaced = '';
+ my @chars = split //, $str;
+
+ for my $i (0 .. $#chars)
+ {
+ my $char = $chars[ $i ];
+
+ if ($char eq '?')
+ {
+ for my $new ('a' .. 'z')
+ {
+ if (($i == 0 || $new ne $chars[ $i - 1 ]) &&
+ ($i == $#chars || $new ne $chars[ $i + 1 ]))
+ {
+ $char = $chars[ $i ] = $new;
+ last;
+ }
+ }
+ }
+
+ $replaced .= $char;
+ }
+
+ return $replaced;
+}
+
+#-------------------------------------------------------------------------------
+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 $replaced = replace_queries( $str );
+
+ is $replaced, $expected, $test_name;
+ }
+
+ done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+ my ($message) = @_;
+
+ die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1 |a?z |abz
+Example 2 |pe?k |peak
+Example 3 |gra?te|grabte
+Adjacent ?|ab??cd|ababcd
+All ? |????? |ababa
diff --git a/challenge-328/athanasius/perl/ch-2.pl b/challenge-328/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..06edee68a8
--- /dev/null
+++ b/challenge-328/athanasius/perl/ch-2.pl
@@ -0,0 +1,178 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 328
+=========================
+
+TASK #2
+-------
+*Good String*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string made up of lower and upper case English letters only.
+
+Write a script to return the good string of the given string. A string is called
+good string if it doesn’t have two adjacent same characters, one in upper case
+and other is lower case.
+
+UPDATE [2025-07-01]: Just to be explicit, you can only remove pair if they are
+same characters, one in lower case and other in upper case, order is not
+important.
+
+Example 1
+
+ Input: $str = "WeEeekly"
+ Output: "Weekly"
+
+ We can remove either, "eE" or "Ee" to make it good.
+
+Example 2
+
+ Input: $str = "abBAdD"
+ Output: ""
+
+ We remove "bB" first: "aAdD"
+ Then we remove "aA": "dD"
+ Finally remove "dD".
+
+Example 3
+
+ Input: $str = "abc"
+ Output: "abc"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string made up of lower and upper case English letters only is entered on
+ the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32; # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+ perl $0 <str>
+ perl $0
+
+ <str> A string made up of lower and upper case English letters only
+END
+
+my $pair_rx;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ $| = 1;
+ print "\nChallenge 328, Task #2: Good String (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+ my $argc = scalar @ARGV;
+
+ if ($argc == 0)
+ {
+ run_tests();
+ }
+ elsif ($argc == 1)
+ {
+ my $str = $ARGV[ 0 ];
+ $str =~ / ([^A-Za-z]) /x and error( qq[Invalid character "$1"] );
+
+ print qq[Input: \$str = "$str"\n];
+
+ my $good_str = get_good_str( $str );
+
+ print qq[Output: "$good_str"\n];
+ }
+ else
+ {
+ error( "Expected 1 or 0 command-line arguments, found $argc" );
+ }
+}
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ my @pairs;
+
+ push @pairs, $_ . uc, uc . $_ for 'a' .. 'z';
+
+ $pair_rx = join '|', @pairs;
+}
+
+#-------------------------------------------------------------------------------
+sub get_good_str
+#-------------------------------------------------------------------------------
+{
+ my ($str) = @_;
+ $str =~ / ^ [A-Za-z]* $ /x or die 'Invalid character';
+
+ 1 while $str =~ s/ $pair_rx //x;
+
+ return $str;
+}
+
+#-------------------------------------------------------------------------------
+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 $good_str = get_good_str( $str );
+
+ is $good_str, $expected, $test_name;
+ }
+
+ done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+ my ($message) = @_;
+
+ die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|WeEeekly|Weekly
+Example 2|abBAdD |
+Example 3|abc |abc
diff --git a/challenge-328/athanasius/raku/ch-1.raku b/challenge-328/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..a15f5529f8
--- /dev/null
+++ b/challenge-328/athanasius/raku/ch-1.raku
@@ -0,0 +1,179 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 328
+=========================
+
+TASK #1
+-------
+*Replace all ?*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing only lower case English letters and ?.
+
+Write a script to replace all ? in the given string so that the string doesn’t
+contain consecutive repeating characters.
+
+Example 1
+
+ Input: $str = "a?z"
+ Output: "abz"
+
+ There can be many strings, one of them is "abz".
+ The choices are 'a' to 'z' but we can't use either 'a' or 'z' to replace the
+ '?'. #'
+
+Example 2
+
+ Input: $str = "pe?k"
+ Output: "peak"
+
+Example 3
+
+ Input: $str = "gra?te"
+ Output: "grabte"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string containing only lower case English letters and "?" is entered on the
+ command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ "\nChallenge 328, Task #1: Replace all ? (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+ #| A string containing only lower case English letters and "?"
+
+ Str:D $str where / ^ <[ a..z ? ]>* $ /
+)
+#===============================================================================
+{
+ qq[Input: \$str = "$str"].put;
+
+ my Str $replaced = replace-queries( $str );
+
+ qq[Output: "$replaced"].put;
+}
+
+#===============================================================================
+multi sub MAIN() # No input: run the test suite
+#===============================================================================
+{
+ run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub replace-queries( Str:D $str where / ^ <[ a..z ? ]>* $ / --> Str:D )
+#-------------------------------------------------------------------------------
+{
+ my Str $replaced = '';
+ my Str @chars = $str.split: '', :skip-empty;
+
+ for 0 .. @chars.end -> UInt $i
+ {
+ my Str $char = @chars[ $i ];
+
+ if $char eq '?'
+ {
+ for 'a' .. 'z' -> Str $new
+ {
+ if ($i == 0 || $new ne @chars[ $i - 1 ]) &&
+ ($i == @chars.end || $new ne @chars[ $i + 1 ])
+ {
+ $char = @chars[ $i ] = $new;
+ last;
+ }
+ }
+ }
+
+ $replaced ~= $char;
+ }
+
+ return $replaced;
+}
+
+#-------------------------------------------------------------------------------
+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 $replaced = replace-queries( $str );
+
+ is $replaced, $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 |a?z |abz
+ Example 2 |pe?k |peak
+ Example 3 |gra?te|grabte
+ Adjacent ?|ab??cd|ababcd
+ All ? |????? |ababa
+ END
+}
+
+################################################################################
diff --git a/challenge-328/athanasius/raku/ch-2.raku b/challenge-328/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..9066b21cb5
--- /dev/null
+++ b/challenge-328/athanasius/raku/ch-2.raku
@@ -0,0 +1,170 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 328
+=========================
+
+TASK #2
+-------
+*Good String*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string made up of lower and upper case English letters only.
+
+Write a script to return the good string of the given string. A string is called
+good string if it doesn’t have two adjacent same characters, one in upper case
+and other is lower case.
+
+UPDATE [2025-07-01]: Just to be explicit, you can only remove pair if they are
+same characters, one in lower case and other in upper case, order is not
+important.
+
+Example 1
+
+ Input: $str = "WeEeekly"
+ Output: "Weekly"
+
+ We can remove either, "eE" or "Ee" to make it good.
+
+Example 2
+
+ Input: $str = "abBAdD"
+ Output: ""
+
+ We remove "bB" first: "aAdD"
+ Then we remove "aA": "dD"
+ Finally remove "dD".
+
+Example 3
+
+ Input: $str = "abc"
+ Output: "abc"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string made up of lower and upper case English letters only is entered on
+ the command-line.
+
+Assumptions
+-----------
+
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Str $pair-rx;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ "\nChallenge 328, Task #2: Good String (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+ #| A string made up of lower and upper case English letters only
+
+ Str:D $str where / ^ <[ A..Z a..z ]>* $ /
+)
+#===============================================================================
+{
+ qq[Input: \$str = "$str"].put;
+
+ my Str $good-str = get-good-str( $str );
+
+ qq[Output: "$good-str"].put:
+}
+
+#===============================================================================
+multi sub MAIN() # No input: run the test suite
+#===============================================================================
+{
+ run-tests();
+}
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ my Str @pairs;
+ @pairs.push: $_ ~ .uc, .uc ~ $_ for 'a' .. 'z';
+
+ $pair-rx = @pairs.join: '||';
+}
+
+#-------------------------------------------------------------------------------
+sub get-good-str( Str:D $str where / ^ <[ A..Z a..z ]>* $ / --> Str:D )
+#-------------------------------------------------------------------------------
+{
+ my Str $good-str = $str;
+
+ Nil while $good-str ~~ s/ <$pair-rx> //;
+
+ return $good-str;
+}
+
+#-------------------------------------------------------------------------------
+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 $good-str = get-good-str( $str );
+
+ is $good-str, $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|WeEeekly|Weekly
+ Example 2|abBAdD |
+ Example 3|abc |abc
+ END
+}
+
+################################################################################