Merge pull request #8256 from wlmb/challenges

Solve PWC222

3 files changed, 40 insertions, 0 deletions

diff --git a/challenge-222/wlmb/blog.txt b/challenge-222/wlmb/blog.txt
new file mode 100644
index 0000000000..4f273e10dc
--- /dev/null
+++ b/challenge-222/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2023/06/19/PWC222/
diff --git a/challenge-222/wlmb/perl/ch-1.pl b/challenge-222/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..201741e699
--- /dev/null
+++ b/challenge-222/wlmb/perl/ch-1.pl
@@ -0,0 +1,14 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 222
+# Task 1:  Matching Members
+#
+# See https://wlmb.github.io/2023/06/19/PWC222/#task-1-matching-members
+use v5.36;
+die <<~"FIN" unless @ARGV;
+    Usage: $0 N1 [N2....]
+    to count how many members of the list N1 N2... match the members of the
+    corresponding sorted list
+    FIN
+my @sorted=sort {$a<=>$b} my @in=@ARGV;
+my @out=grep {$sorted[$_]==$in[$_]} 0..@in-1;
+say "@in -> ", 0+@out;
diff --git a/challenge-222/wlmb/perl/ch-2.pl b/challenge-222/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..24de53fd9a
--- /dev/null
+++ b/challenge-222/wlmb/perl/ch-2.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 222
+# Task 2:  Last Member
+#
+# See https://wlmb.github.io/2023/06/19/PWC222/#task-2-last-member
+use v5.36;
+use List::Util qw(first all);
+die <<~"FIN" unless @ARGV;
+    Usage: $0 N1 [N2...]
+    to find last member from list N1 N2...
+    after iteratively eliminating equal pairs
+    and replacing unequal pairs by their differences,
+    starting from the highest values.
+    FIN
+# If non-positive are allowed, the result 0 becomes ambiguous.
+# Not necessary to check for integers, though.
+die "Expected positive numbers" unless all {$_>0} @ARGV;
+my @list = sort {$b <=> $a} @ARGV;
+while(@list>1){
+    my ($x, $y)=splice @list, 0, 2; # Remove largest two elements.
+    next unless $x-=$y;             # Were they equal?
+    my $i=(first {$list[$_]<=$x} 0..@list - 1) // @list + 1; # No. Fin where to insert difference
+    splice @list, $i, 0, $x;
+}
+say "@ARGV->", $list[0]//0; # Print single remaining element or 0 if none.