Merge pull request #8481 from wlmb/challenges

Solve PWC228

3 files changed, 39 insertions, 0 deletions

diff --git a/challenge-228/wlmb/blog.txt b/challenge-228/wlmb/blog.txt
new file mode 100644
index 0000000000..be2a50f129
--- /dev/null
+++ b/challenge-228/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2023/07/31/PWC228/
diff --git a/challenge-228/wlmb/perl/ch-1.pl b/challenge-228/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..fd5a773be1
--- /dev/null
+++ b/challenge-228/wlmb/perl/ch-1.pl
@@ -0,0 +1,14 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 228
+# Task 1:  Unique Sum
+#
+# See https://wlmb.github.io/2023/07/31/PWC228/#task-1-unique-sum
+use v5.36;
+use List::Util qw(sum0);
+die <<~"FIN" unless @ARGV;
+    Usage $0 N1 [N2... ]
+    to sum unique elements of the array (N1 N2...)
+    FIN
+my %count;
+++$count{$_} for @ARGV;
+say "@ARGV -> ",  sum0 grep {$count{$_}==1} @ARGV
diff --git a/challenge-228/wlmb/perl/ch-2.pl b/challenge-228/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..214720e552
--- /dev/null
+++ b/challenge-228/wlmb/perl/ch-2.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 228
+# Task 2:  Empty Array
+#
+# See https://wlmb.github.io/2023/07/31/PWC228/#task-2-empty-array
+use v5.36;
+use PDL;
+die <<~"FIN" unless @ARGV;
+    Usage $0 N1 [N2...]
+    to count how many operations are required to empty the
+    array (N1 N2...)
+    FIN
+my $x=(my $in=pdl(@ARGV))->copy;
+my $count=0;
+while($x->nelem>1){              # while there are two or more elements
+   my $min=$x->min;
+   my $idx=which($x==$min)->at(0); # index of minimum element
+   $count+=$idx+1;               # num. of ops. to empty minimum element
+   $x=$x->rotate(-$idx)          # bring smallest element to the front, rotating to the
+                                 # end the initial larger elements
+        ->slice([1,-1,1]);       # remove smallest element, keep the rest
+}
+++$count;                        # add the removal of the last element
+say "$in -> $count";