Merge pull request #10135 from wlmb/challenges

Add more robust solution

1 files changed, 42 insertions, 0 deletions

diff --git a/challenge-270/wlmb/perl/ch-2a.pl b/challenge-270/wlmb/perl/ch-2a.pl
new file mode 100755
index 0000000000..d69b38b2e0
--- /dev/null
+++ b/challenge-270/wlmb/perl/ch-2a.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
+    @decreasing=sort {$b<=>$a} @decreasing; # sort again :(
+    $total=$precost+cost(@decreasing);
+    last if $total > $oldtotal;  # finish when there is no gain
+    $oldtotal=$total;
+}
+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;
+}