Merge pull request #12850 from PerlBoy1967/branch-for-challenge-343

w343 - Task 1 & 2 (Perl)

2 files changed, 123 insertions, 0 deletions

diff --git a/challenge-343/perlboy1967/perl/ch1.pl b/challenge-343/perlboy1967/perl/ch1.pl
new file mode 100755
index 0000000000..39c495e03b
--- /dev/null
+++ b/challenge-343/perlboy1967/perl/ch1.pl
@@ -0,0 +1,44 @@
+#!/bin/perl
+
+=pod
+
+L<https://theweeklychallenge.org/blog/perl-weekly-challenge-343#TASK1>
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 1: Zero Friend
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of numbers.
+
+Find the number that is closest to zero and return its distance to zero.
+
+=cut
+
+use Test2::V0 qw(-no_srand);
+use exact 'v5.32', -signatures;
+
+use List::Util qw(min);
+use List::MoreUtils qw(any);
+
+sub zeroFriendMap (@ints) {
+  min map { abs($_) } @ints;
+}
+
+sub zeroFriend (@ints) {
+  my $m;
+  any { $m = min($m // (),abs($_)); $_ == 0 } @ints;
+  return $m;
+}
+
+is(zeroFriend(4,2,-1,3,-2),1,'Example 1');
+is(zeroFriend(-5,5,-3,3,-1,1),1,'Example 2');
+is(zeroFriend(7,-3,0,2,-8),0,'Example 3');
+is(zeroFriend(-2,-5,-1,-8),1,'Example 4');
+is(zeroFriend(-2,2,-4,4,-1,1),1,'Example 5');
+
+is(zeroFriend((0) x 100_000),0,'Own example 1');
+is(zeroFriend(1 .. 1000,0,1 .. 1000),0,'Own example 2');
+is(zeroFriend((1 .. 2000,0)),0,'Own example 3');
+ 
+done_testing;
diff --git a/challenge-343/perlboy1967/perl/ch2.pl b/challenge-343/perlboy1967/perl/ch2.pl
new file mode 100755
index 0000000000..2f049d4ce7
--- /dev/null
+++ b/challenge-343/perlboy1967/perl/ch2.pl
@@ -0,0 +1,79 @@
+#!/bin/perl
+
+=pod
+
+L<https://theweeklychallenge.org/blog/perl-weekly-challenge-343#TASK2>
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 2: Champion Team
+Submitted by: Mohammad Sajid Anwar
+
+You have n teams in a tournament. A matrix grid tells you which team is stronger
+between any two teams:
+
+|| If grid[i][j] == 1, then team i is stronger than team j
+|| If grid[i][j] == 0, then team j is stronger than team i
+
+Find the champion team - the one with most wins, or if there is no single such
+team, the strongest of the teams with most wins. (You may assume that there is a
+definite answer.)
+
+=cut
+
+use Test2::V0 qw(-no_srand);
+use exact 'v5.32', -signatures;
+
+use List::Util qw(sum max);
+
+sub championTeam (@grid) {
+  my %w;
+
+  # Process wins against teams
+  for (0 .. $#grid) {
+    push(@{$w{sum(@{$grid[$_]})}},$_);
+  }
+
+  # Get max scoring team(s)
+  my @w = @{$w{max(keys(%w))}};
+
+  # One winning team? Return it!
+  return $w[0] if scalar @w == 1;
+
+  # Multiple best scoring teams, find the best one
+  my %uw = map { (sum(@{$grid[$_]}[@w]),$_) } @w;
+  return $uw{max keys %uw};
+}
+
+is(championTeam([0,1,1],
+                [0,0,1],
+                [0,0,0]),
+                0,q{Example 1});
+is(championTeam([0,1,0,0],
+                [0,0,0,0],
+                [1,1,0,0],
+                [1,1,1,0]),
+                3,q{Example 2});
+is(championTeam([0,1,0,1],
+                [0,0,1,1],
+                [1,0,0,0],
+                [0,0,1,0]),
+                0,q{Example 3});
+is(championTeam([0,1,1],
+                [0,0,0],
+                [0,1,0]),
+                0,q{Example 4});
+is(championTeam([0,0,0,0,0],
+                [1,0,0,0,0],
+                [1,1,0,1,1],
+                [1,1,0,0,0],
+                [1,1,0,1,0]),
+                2,q{Example 5});
+is(championTeam([0,1,1,1,0,0],
+                [0,0,1,0,1,1],
+                [0,0,0,0,1,1],
+                [0,1,1,0,1,1],
+                [1,0,0,0,0,0],
+                [1,0,0,0,1,0]),
+                3,q{Matthias Muth's test});
+done_testing;