From 03cb580905e2075cec196bc085346ab534eb6257 Mon Sep 17 00:00:00 2001
From: Niels van Dijke <perlboy@cpan.org>
Date: Mon, 21 Nov 2022 21:53:01 +0000
Subject: w192 - Task 2

---
 challenge-192/perlboy1967/perl/ch-2.pl | 91 ++++++++++++++++++++++++++++++++++
 1 file changed, 91 insertions(+)
 create mode 100755 challenge-192/perlboy1967/perl/ch-2.pl

diff --git a/challenge-192/perlboy1967/perl/ch-2.pl b/challenge-192/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..5e9fc3e944
--- /dev/null
+++ b/challenge-192/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,91 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 192
+ - https://theweeklychallenge.org/blog/perl-weekly-challenge-192/#TASK2
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 2: Equal Distribution
+Submitted by: Mohammad S Anwar
+
+You are given a list of integers greater than or equal to zero, @list.
+
+Write a script to distribute the number so that each members are same. 
+If you succeed then print the total moves otherwise print -1.
+
+Please follow the rules (as suggested by Neils van Dijke [2022-11-21 13:00]
+
+1) You can only move a value of '1' per move
+2) You are only allowed to move a value of '1' to a direct neighbor/adjacent cell
+
+=cut
+
+use v5.16;
+use warnings;
+
+use Test::More;
+
+use List::Util qw(sum max);
+use List::MoreUtils qw(firstidx);
+
+my @t = (
+  [[1,0,5], 4],
+  [[0,2,0],-1],
+  [[0,3,0], 2],
+  [[0,0,0], 0],
+  [[0,8,1,1,6,2], 8],
+  [[1,2,3,4,5,6,7,8,9], 60],
+  [[1,3,2,5,4,7,6,9,8], 56],
+);
+
+
+sub equalDistribution {
+  printf "Input: [%s]\n", join(',',@_);
+
+  my $sum = sum(@_);
+  my $n = scalar(@_);
+  my $avg = $sum/$n;
+
+  return -1 if (int($sum/$n) != $avg);
+
+  my $m = 0;
+  while (1) {
+    my $max = max(@_);
+    last if ($max == $avg);
+
+    $m++;
+
+    my $i = firstidx { $_ == $max } @_;
+
+    # Which side needs the +1 the most?
+    if ($i == 0) {
+      $_[1]++;
+    } elsif ($i == $n-1) {
+      $_[-2]++;
+    } else {
+      my @l = @_[0 .. $i-1];
+      my @r = @_[$i+1 .. $n-1];
+
+      if (sum(@l)/scalar(@l) < sum(@r)/scalar(@r)) {
+        $_[$i-1]++;
+      } else {
+        $_[$i+1]++;
+      }
+    }
+
+    $_[$i]--; 
+
+    printf "Move %d: [%s]\n", $m, join(',',@_);
+  }
+
+  return $m;
+}
+
+
+for (@t) {
+  is(equalDistribution(@{$$_[0]}),$$_[1]);
+}
+
+done_testing;
-- 
cgit 


From 09449f5bfe26348aa3a5ea7e22e0c2ca1f845f00 Mon Sep 17 00:00:00 2001
From: Niels van Dijke <perlboy@cpan.org>
Date: Mon, 21 Nov 2022 21:58:46 +0000
Subject: Minor cleanup

---
 challenge-192/perlboy1967/perl/ch-2.pl | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/challenge-192/perlboy1967/perl/ch-2.pl b/challenge-192/perlboy1967/perl/ch-2.pl
index 5e9fc3e944..7f45d5e22d 100755
--- a/challenge-192/perlboy1967/perl/ch-2.pl
+++ b/challenge-192/perlboy1967/perl/ch-2.pl
@@ -46,9 +46,10 @@ sub equalDistribution {
 
   my $sum = sum(@_);
   my $n = scalar(@_);
-  my $avg = $sum/$n;
 
-  return -1 if (int($sum/$n) != $avg);
+  return -1 if ($sum % $n != 0);
+
+  my $avg = $sum/$n;
 
   my $m = 0;
   while (1) {
-- 
cgit 


From 989174bfed72b2f3e1c0e66edd8ca8221636fd98 Mon Sep 17 00:00:00 2001
From: Niels van Dijke <perlboy@cpan.org>
Date: Mon, 21 Nov 2022 22:20:42 +0000
Subject: Code polishing

---
 challenge-192/perlboy1967/perl/ch-2.pl | 25 ++++++++++---------------
 1 file changed, 10 insertions(+), 15 deletions(-)

diff --git a/challenge-192/perlboy1967/perl/ch-2.pl b/challenge-192/perlboy1967/perl/ch-2.pl
index 7f45d5e22d..49f56eda22 100755
--- a/challenge-192/perlboy1967/perl/ch-2.pl
+++ b/challenge-192/perlboy1967/perl/ch-2.pl
@@ -27,8 +27,8 @@ use warnings;
 
 use Test::More;
 
-use List::Util qw(sum max);
-use List::MoreUtils qw(firstidx);
+use List::Util qw(sum);
+use List::MoreUtils qw(firstidx minmax);
 
 my @t = (
   [[1,0,5], 4],
@@ -53,7 +53,7 @@ sub equalDistribution {
 
   my $m = 0;
   while (1) {
-    my $max = max(@_);
+    my ($min,$max) = minmax(@_);
     last if ($max == $avg);
 
     $m++;
@@ -61,19 +61,14 @@ sub equalDistribution {
     my $i = firstidx { $_ == $max } @_;
 
     # Which side needs the +1 the most?
-    if ($i == 0) {
-      $_[1]++;
-    } elsif ($i == $n-1) {
-      $_[-2]++;
+    my @l = @_[0 .. $i-1];
+    my @r = @_[$i+1 .. $n-1];
+
+    if ((scalar(@l) ? sum(@l)/scalar(@l) : $min-1) < 
+        (scalar(@r) ? sum(@r)/scalar(@r) : $max+1)) {
+      $_[$i-1]++;
     } else {
-      my @l = @_[0 .. $i-1];
-      my @r = @_[$i+1 .. $n-1];
-
-      if (sum(@l)/scalar(@l) < sum(@r)/scalar(@r)) {
-        $_[$i-1]++;
-      } else {
-        $_[$i+1]++;
-      }
+      $_[$i+1]++;
     }
 
     $_[$i]--; 
-- 
cgit 


From 9ba1a49d2ded761d2a7822d721407cefa82a4ec3 Mon Sep 17 00:00:00 2001
From: Niels van Dijke <perlboy@cpan.org>
Date: Mon, 21 Nov 2022 22:38:11 +0000
Subject: Drop average and use minmax

---
 challenge-192/perlboy1967/perl/ch-2.pl | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/challenge-192/perlboy1967/perl/ch-2.pl b/challenge-192/perlboy1967/perl/ch-2.pl
index 49f56eda22..8404b5449b 100755
--- a/challenge-192/perlboy1967/perl/ch-2.pl
+++ b/challenge-192/perlboy1967/perl/ch-2.pl
@@ -49,12 +49,10 @@ sub equalDistribution {
 
   return -1 if ($sum % $n != 0);
 
-  my $avg = $sum/$n;
-
   my $m = 0;
   while (1) {
     my ($min,$max) = minmax(@_);
-    last if ($max == $avg);
+    last if ($min == $max);
 
     $m++;
 
-- 
cgit