Merge pull request #10177 from wlmb/challenges

Add third solution to PWC270

4 files changed, 79 insertions, 0 deletions

diff --git a/challenge-270/wlmb/perl/ch-2b.pl b/challenge-270/wlmb/perl/ch-2b.pl
new file mode 100755
index 0000000000..38318a45f9
--- /dev/null
+++ b/challenge-270/wlmb/perl/ch-2b.pl
@@ -0,0 +1,42 @@
+#!/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 $oldtotal = my $total = cost(@decreasing);
+my $precost=0;
+while(1){
+    ++$decreasing[-1]; # perform level 2 on smallest elements
+    ++$decreasing[-2];
+    $precost += $y;    # add cost
+    last if $precost > $oldtotal;
+    @decreasing=sort {$b<=>$a} @decreasing; # sort again :(
+    $total=$precost+cost(@decreasing);
+    $oldtotal=$total if $total < $oldtotal;
+}
+say "x=$x, y=$y, ints= @ARGV -> $oldtotal";
+
+sub cost(@decreasing){
+    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
+        }
+    }
+    return $total;
+}
diff --git a/challenge-271/wlmb/blog.txt b/challenge-271/wlmb/blog.txt
new file mode 100644
index 0000000000..fb39070635
--- /dev/null
+++ b/challenge-271/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2024/05/28/PWC271/
diff --git a/challenge-271/wlmb/perl/ch-1.pl b/challenge-271/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..692082a697
--- /dev/null
+++ b/challenge-271/wlmb/perl/ch-1.pl
@@ -0,0 +1,19 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 271
+# Task 1:  Maximum Ones
+#
+# See https://wlmb.github.io/2024/05/28/PWC271/#task-1-maximum-ones
+use v5.36;
+use PDL;
+die <<~"FIN" unless @ARGV;
+    Usage: $0 [[m11 m12...][m21 m22...]...]
+    to find the row with the largest number of 1 entries,
+    or the first largest row in case of a tie.
+    Rows are numbered from 1 upwards.
+    FIN
+for(@ARGV){
+    my $in=pdl($_);
+    my @ones=($in==1)->sumover->dog; # ones in each row
+    my @sorted=sort {$ones[$b] <=> $ones[$a] || $a<=>$b} 0..@ones-1;
+    say "$in -> ",1+$sorted[0];
+}
diff --git a/challenge-271/wlmb/perl/ch-2.pl b/challenge-271/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..7fb7e827ae
--- /dev/null
+++ b/challenge-271/wlmb/perl/ch-2.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 271
+# Task 2:  Sort by 1 bits
+#
+# See https://wlmb.github.io/2024/05/28/PWC271/#task-2-sort-by-1-bits
+use v5.36;
+die <<~"FIN" unless @ARGV;
+    Usage: $0 N1 N2...
+    to sort the numbers N1, N2... according to the number of 1 bits
+    and then according to value
+    FIN
+my @sorted = sort {ones($a) <=> ones($b) || $a<=>$b} @ARGV;
+say "@ARGV -> @sorted";
+
+sub ones($x){
+    0+grep{$_}split "", sprintf "%b",$x;
+}