diff options
| author | HVukman <peterslopp@googlemail.com> | 2025-07-06 16:30:23 +0200 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2025-07-06 16:30:23 +0200 |
| commit | 17808ae69b75b4f9675568f62052095daabb34ec (patch) | |
| tree | c8df39c66c41f2db02f62e614489106aa5521be0 | |
| parent | d01d8eef0858daf23559c629a6e674e31bd39196 (diff) | |
| parent | 0051e231d1cd185a67e698c8be88fed0fe1f0b0c (diff) | |
| download | perlweeklychallenge-club-17808ae69b75b4f9675568f62052095daabb34ec.tar.gz perlweeklychallenge-club-17808ae69b75b4f9675568f62052095daabb34ec.tar.bz2 perlweeklychallenge-club-17808ae69b75b4f9675568f62052095daabb34ec.zip | |
Merge branch 'manwar:master' into branch-for-challenge-328
70 files changed, 2655 insertions, 166 deletions
diff --git a/challenge-328/0rir/raku/ch-1.raku b/challenge-328/0rir/raku/ch-1.raku new file mode 100644 index 0000000000..fc78ba89b1 --- /dev/null +++ b/challenge-328/0rir/raku/ch-1.raku @@ -0,0 +1,87 @@ +#!/usr/bin/env raku +# :vim ft=raku sw=4 expandtab # 🦋 ∅∪∩∋∈∉⊆ ≡ ≢ « » ∴ +use v6.d; +use Test; + +=begin comment +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 + +my @Test = + "", "", + "?", "a", + 'z', "z", + "a?", "ab", + "?a", "ba", + "??", "ab", + "??a", "aba", + "b??", "bab", + "gra?te", "grabte", + "g?a?te", "gbabte", + "g???te", "gabate", + "g????e", "gababe", + "g?????", "gababa", + 'xy', 'xy', + "xyz", "xyz", + "azc", "azc", + "pe?k", "peak", + "??????", "ababab", + "g?a?te", "gbabte", +; + +plan +@Test ÷ 2; + +# Here we follow a pattern suggested by the examples: replace with the +# alphabetically first char that fits. + +constant \fix-me = '?'; # Char value needing replacement. +constant \first-choice = 'a'; # First choice for substitutions. +constant \filler = '!'; # Out of band value for stand-ins. + +sub alter( Any:D $q-mark is rw, :$prefix = filler, :$suffix = filler -->Nil) { + $q-mark = first-choice; + quietly ++$q-mark while $q-mark eq any($prefix, $suffix); + return; +} + +multi task( Str:D $a where *.chars == 0 -->Str) { '' } +multi task( Str:D $a where *.chars == 1 -->Str) { + $a eq fix-me ?? first-choice !! $a ; +} +multi task( Str:D $a where *.chars ≥ 1 --> Str) { + my @s = $a.comb; + + if @s[0] eq fix-me { alter @s[0], :suffix(@s[1]) } + + for 1..(@s.end) -> \i { + next if @s[i] ne fix-me; + alter @s[i], :prefix(@s[i-1]), :suffix( @s[i+1]); + } + + if @s[*.end] eq fix-me { alter @s[*.end], :prefix(@s[*.end-1]) } + @s.join; +} + +for @Test -> $in, $exp, { + is task( $in), $exp, "{$exp // $exp.^name()} <- $in.raku()"; +} + +done-testing; + +my $str = "??????a?g?r???a?te?"; + +say qq{\nInput: \$str = "$str"\nOutput: "}, task($str), '"'; diff --git a/challenge-328/0rir/raku/ch-2.raku b/challenge-328/0rir/raku/ch-2.raku new file mode 100644 index 0000000000..446baf13d2 --- /dev/null +++ b/challenge-328/0rir/raku/ch-2.raku @@ -0,0 +1,60 @@ +#!/usr/bin/env raku +# :vim ft=raku sw=4 expandtab # 🦋 ∅∪∩∋∈∉⊆ ≡ ≢ « » ∴ +use v6.d; +use Test; + +=begin comment +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 + +my @Test = + # $in $exp + "WeEeekly", "Weekly", + "abBAdD", "", + "abc", "abc", + 'abcdefghHGFEDCBa', 'aa', + 'bcdefghHGFEDCBa', 'a', + 'abcdefghHGFEDCB', 'a', + "XxabBAdD", '', + "XxnabBAmdD", 'nm', + "AaXxnabBAmdDzZ", 'nm', +; +plan +@Test ÷ 2; + +constant XCASE = 32; + +sub task( Str $a is copy --> Str) { + my $unchanged; + repeat { + $unchanged = $a; + $a ~~ s:g/ (<:L>)(<:L>) <?{ XCASE == abs($0.ord-$1.ord)}>//; + } until $a eq $unchanged; + $a; +} + +for @Test -> $in, $exp { + is task( $in), $exp, "{$exp // $exp.^name()} <- $in.raku()"; +} +done-testing; + +my $str = "AaaAaBbbbBCcc"; + +say qq{\nInput: \$str = "$str"\nOutput: "}, task( $str), '"'; + diff --git a/challenge-328/arne-sommer/blog.txt b/challenge-328/arne-sommer/blog.txt new file mode 100644 index 0000000000..89e7fd30e0 --- /dev/null +++ b/challenge-328/arne-sommer/blog.txt @@ -0,0 +1 @@ +https://raku-musings.com/all-good.html diff --git a/challenge-328/arne-sommer/raku/ch-1.raku b/challenge-328/arne-sommer/raku/ch-1.raku new file mode 100755 index 0000000000..c362d537b4 --- /dev/null +++ b/challenge-328/arne-sommer/raku/ch-1.raku @@ -0,0 +1,34 @@ +#! /usr/bin/env raku + +unit sub MAIN ($str where $str ~~ /^<[a..z \?]>+$/, + :v(:$verbose)); + +my @str = $str.comb; +my $prev = ''; +my $result = ''; +my $end = @str.end; + +for 0 .. $end -> $index +{ + my $current = @str[$index]; + my $next = $index >= $end ?? "" !! @str[$index +1]; + + if $current eq '?' + { + say ": Replace ? with anything != ($prev, $next)" if $verbose; + my $s = ('a' .. 'z') (-) ($prev, $next); + my $pick = $s.pick; + say ": From: { $s.keys.sort.join(",") } -> $pick" if $verbose; + + $result ~= $pick; + $prev = $pick; + } + else + { + say ": Added normal letter $current" if $verbose; + $result ~= $current; + $prev = $current; + } +} + +say $result; diff --git a/challenge-328/arne-sommer/raku/ch-2.raku b/challenge-328/arne-sommer/raku/ch-2.raku new file mode 100755 index 0000000000..47736801f4 --- /dev/null +++ b/challenge-328/arne-sommer/raku/ch-2.raku @@ -0,0 +1,35 @@ +#! /usr/bin/env raku + +unit sub MAIN ($str is copy where $str ~~ /^<[ a..z A..Z ]>+$/, + :v(:$verbose)); + +my $index = 0; + +loop +{ + my $end = $str.chars -1; + my $current = $str.substr($index, 1); + + last if $end == -1; + last if $index == $end; + + my $next = $str.substr($index +1, 1); + + print ": Checking '$current$next' (index $index)" if $verbose; + + if $current.lc eq $next.lc && $current ne $next + { + $str.substr-rw($index,2) = ""; + + say " - replace with nothing -> $str" if $verbose; + + $index-- unless $index == 0; + } + else + { + say "" if $verbose; + $index++; + } +} + +say $str; diff --git a/challenge-328/arne-sommer/raku/good-string b/challenge-328/arne-sommer/raku/good-string new file mode 100755 index 0000000000..47736801f4 --- /dev/null +++ b/challenge-328/arne-sommer/raku/good-string @@ -0,0 +1,35 @@ +#! /usr/bin/env raku + +unit sub MAIN ($str is copy where $str ~~ /^<[ a..z A..Z ]>+$/, + :v(:$verbose)); + +my $index = 0; + +loop +{ + my $end = $str.chars -1; + my $current = $str.substr($index, 1); + + last if $end == -1; + last if $index == $end; + + my $next = $str.substr($index +1, 1); + + print ": Checking '$current$next' (index $index)" if $verbose; + + if $current.lc eq $next.lc && $current ne $next + { + $str.substr-rw($index,2) = ""; + + say " - replace with nothing -> $str" if $verbose; + + $index-- unless $index == 0; + } + else + { + say "" if $verbose; + $index++; + } +} + +say $str; diff --git a/challenge-328/arne-sommer/raku/replace-all-qm b/challenge-328/arne-sommer/raku/replace-all-qm new file mode 100755 index 0000000000..c362d537b4 --- /dev/null +++ b/challenge-328/arne-sommer/raku/replace-all-qm @@ -0,0 +1,34 @@ +#! /usr/bin/env raku + +unit sub MAIN ($str where $str ~~ /^<[a..z \?]>+$/, + :v(:$verbose)); + +my @str = $str.comb; +my $prev = ''; +my $result = ''; +my $end = @str.end; + +for 0 .. $end -> $index +{ + my $current = @str[$index]; + my $next = $index >= $end ?? "" !! @str[$index +1]; + + if $current eq '?' + { + say ": Replace ? with anything != ($prev, $next)" if $verbose; + my $s = ('a' .. 'z') (-) ($prev, $next); + my $pick = $s.pick; + say ": From: { $s.keys.sort.join(",") } -> $pick" if $verbose; + + $result ~= $pick; + $prev = $pick; + } + else + { + say ": Added normal letter $current" if $verbose; + $result ~= $current; + $prev = $current; + } +} + +say $result; 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. |
