aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHVukman <peterslopp@googlemail.com>2025-07-06 16:30:23 +0200
committerGitHub <noreply@github.com>2025-07-06 16:30:23 +0200
commit17808ae69b75b4f9675568f62052095daabb34ec (patch)
treec8df39c66c41f2db02f62e614489106aa5521be0
parentd01d8eef0858daf23559c629a6e674e31bd39196 (diff)
parent0051e231d1cd185a67e698c8be88fed0fe1f0b0c (diff)
downloadperlweeklychallenge-club-17808ae69b75b4f9675568f62052095daabb34ec.tar.gz
perlweeklychallenge-club-17808ae69b75b4f9675568f62052095daabb34ec.tar.bz2
perlweeklychallenge-club-17808ae69b75b4f9675568f62052095daabb34ec.zip
Merge branch 'manwar:master' into branch-for-challenge-328
-rw-r--r--challenge-328/0rir/raku/ch-1.raku87
-rw-r--r--challenge-328/0rir/raku/ch-2.raku60
-rw-r--r--challenge-328/arne-sommer/blog.txt1
-rwxr-xr-xchallenge-328/arne-sommer/raku/ch-1.raku34
-rwxr-xr-xchallenge-328/arne-sommer/raku/ch-2.raku35
-rwxr-xr-xchallenge-328/arne-sommer/raku/good-string35
-rwxr-xr-xchallenge-328/arne-sommer/raku/replace-all-qm34
-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
-rw-r--r--challenge-328/bob-lied/README.md6
-rw-r--r--challenge-328/bob-lied/perl/ch-1.pl89
-rw-r--r--challenge-328/bob-lied/perl/ch-2.pl75
-rw-r--r--challenge-328/jo-37/blog.txt1
-rwxr-xr-xchallenge-328/jo-37/perl/ch-1.pl101
-rwxr-xr-xchallenge-328/jo-37/perl/ch-2.pl117
-rw-r--r--challenge-328/kjetillll/perl/ch-1.pl19
-rw-r--r--challenge-328/kjetillll/perl/ch-2.pl16
-rw-r--r--challenge-328/mahnkong/perl/ch-1.pl30
-rw-r--r--challenge-328/mahnkong/perl/ch-2.pl26
-rw-r--r--challenge-328/mark-anderson/raku/ch-2.raku5
-rw-r--r--challenge-328/packy-anderson/README.md2
-rw-r--r--challenge-328/packy-anderson/blog.txt1
-rwxr-xr-xchallenge-328/packy-anderson/elixir/ch-1.exs45
-rwxr-xr-xchallenge-328/packy-anderson/elixir/ch-2.exs71
-rwxr-xr-xchallenge-328/packy-anderson/perl/ch-1.pl46
-rwxr-xr-xchallenge-328/packy-anderson/perl/ch-2.pl31
-rwxr-xr-xchallenge-328/packy-anderson/python/ch-1.py50
-rwxr-xr-xchallenge-328/packy-anderson/python/ch-2.py55
-rwxr-xr-xchallenge-328/packy-anderson/raku/ch-1.raku42
-rwxr-xr-xchallenge-328/packy-anderson/raku/ch-2.raku32
-rwxr-xr-xchallenge-328/perlboy1967/perl/ch-1.pl37
-rwxr-xr-xchallenge-328/perlboy1967/perl/ch-2.pl40
-rwxr-xr-xchallenge-328/peter-meszaros/perl/ch-1.pl72
-rwxr-xr-xchallenge-328/peter-meszaros/perl/ch-2.pl72
-rwxr-xr-xchallenge-328/peter-meszaros/tcl/ch-1.tcl75
-rwxr-xr-xchallenge-328/peter-meszaros/tcl/ch-2.tcl71
-rw-r--r--challenge-328/simon-proctor/README2
-rw-r--r--challenge-328/simon-proctor/blog.txt1
-rwxr-xr-xchallenge-328/simon-proctor/raku/ch-2.raku2
-rw-r--r--challenge-328/wlmb/blog.txt1
-rwxr-xr-xchallenge-328/wlmb/perl/ch-1.pl24
-rwxr-xr-xchallenge-328/wlmb/perl/ch-2.pl17
-rw-r--r--challenge-328/ysth/blog-2.txt1
-rw-r--r--challenge-328/ysth/perl/ch-2.pl11
-rw-r--r--challenge-328/ysth/python/ch-2.py14
-rw-r--r--stats/pwc-current.json222
-rw-r--r--stats/pwc-language-breakdown-2019.json2
-rw-r--r--stats/pwc-language-breakdown-2020.json2
-rw-r--r--stats/pwc-language-breakdown-2021.json2
-rw-r--r--stats/pwc-language-breakdown-2022.json2
-rw-r--r--stats/pwc-language-breakdown-2023.json2
-rw-r--r--stats/pwc-language-breakdown-2024.json2
-rw-r--r--stats/pwc-language-breakdown-2025.json10
-rw-r--r--stats/pwc-language-breakdown-summary.json8
-rw-r--r--stats/pwc-leaders.json156
-rw-r--r--stats/pwc-summary-1-30.json8
-rw-r--r--stats/pwc-summary-121-150.json6
-rw-r--r--stats/pwc-summary-151-180.json8
-rw-r--r--stats/pwc-summary-181-210.json4
-rw-r--r--stats/pwc-summary-211-240.json10
-rw-r--r--stats/pwc-summary-241-270.json4
-rw-r--r--stats/pwc-summary-271-300.json4
-rw-r--r--stats/pwc-summary-301-330.json10
-rw-r--r--stats/pwc-summary-31-60.json8
-rw-r--r--stats/pwc-summary-61-90.json2
-rw-r--r--stats/pwc-summary-91-120.json2
-rw-r--r--stats/pwc-summary.json42
-rw-r--r--stats/pwc-yearly-language-summary.json10
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.