From 9df16ca67e65d7bb16b4bfbc873d570e913f8834 Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Sat, 5 Jul 2025 18:23:46 +1000 Subject: Perl & Raku solutions to Tasks 1 & 2 for Week 328 --- challenge-328/athanasius/perl/ch-1.pl | 182 ++++++++++++++++++++++++++++++++ challenge-328/athanasius/perl/ch-2.pl | 178 +++++++++++++++++++++++++++++++ challenge-328/athanasius/raku/ch-1.raku | 179 +++++++++++++++++++++++++++++++ challenge-328/athanasius/raku/ch-2.raku | 170 +++++++++++++++++++++++++++++ 4 files changed, 709 insertions(+) create mode 100644 challenge-328/athanasius/perl/ch-1.pl create mode 100644 challenge-328/athanasius/perl/ch-2.pl create mode 100644 challenge-328/athanasius/raku/ch-1.raku create mode 100644 challenge-328/athanasius/raku/ch-2.raku 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 => < + perl $0 + + 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 = ) + { + 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 => < + perl $0 + + 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 = ) + { + 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 +} + +################################################################################ -- cgit