Merge pull request #10132 from wlmb/challenges

Solve PWC270

3 files changed, 50 insertions, 0 deletions

diff --git a/challenge-270/wlmb/blog.txt b/challenge-270/wlmb/blog.txt
new file mode 100644
index 0000000000..6d83f63fbc
--- /dev/null
+++ b/challenge-270/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2024/05/20/PWC270/
diff --git a/challenge-270/wlmb/perl/ch-1.pl b/challenge-270/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..3fa84a3a8a
--- /dev/null
+++ b/challenge-270/wlmb/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 270
+# Task 1:  Special Positions
+#
+# See https://wlmb.github.io/2024/05/20/PWC270/#task-1-special-positions
+use v5.36;
+use PDL;
+die <<~"FIN" unless @ARGV;
+    Usage: $0 M1 M2...
+    where M1, M2... are strings that represent matrices, of the form
+    "[[m11 m12...][m21 m22...]...]"
+    FIN
+for(@ARGV){
+    my $x=pdl($_);
+    say "$x -> ",
+	(($x) # value is not zero
+	 &(($x->borover==1)->dummy(0)) # only 0's and 1's in row
+	 &(($x->transpose->borover==1)->dummy(1)) # only 0's and 1's in column
+	 &(($x->sumover==1)->dummy(0)) # only one 1 in row
+	 &(($x->transpose->sumover==1)->dummy(1)) # only one 1 in column
+	)->sum;
+}
diff --git a/challenge-270/wlmb/perl/ch-2.pl b/challenge-270/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..a4e39f8f79
--- /dev/null
+++ b/challenge-270/wlmb/perl/ch-2.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 270
+# Task 2:  Distribute Elements
+#
+# See https://wlmb.github.io/2024/05/20/PWC270/#task-2-distribute-elements
+use v5.36;
+die <<~"FIN" unless @ARGV >= 2;
+    Usage: $0 X Y A1 A2...
+    to find the minimum cost of maeking all elements of the array A1 A2... equal
+    by adding 1 to individual elements, with cost X or adding 1 to pairs of
+    elements with cost Y.
+    FIN
+my ($x, $y)=(shift,shift);
+my $prefer_two=$y<2*$x;
+my @decreasing = sort {$b<=>$a} @ARGV;
+my $max = shift @decreasing;
+my $total = 0;
+while(@decreasing){
+    my $steps = $max - shift @decreasing;
+    if($prefer_two && @decreasing){ # Can I do level 2?
+	$decreasing[0] += $steps;   # Update next element
+	$total += $steps * $y;      # Update total cost
+    }else{                          # level 1 instead
+	$total += $steps * $x;      # Update total cost
+    }
+}
+say "x=$x, y=$y, ints= @ARGV -> $total"