aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMohammad Sajid Anwar <Mohammad.Anwar@yahoo.com>2025-10-19 21:15:30 +0100
committerGitHub <noreply@github.com>2025-10-19 21:15:30 +0100
commit2a7340b4037ab852921bf0b804ed4cade0044dfe (patch)
tree14338934f7ab736213a8da7cd22b4880eb9d594c
parentbd396320750457f49888b9938e057eac5d59f5f8 (diff)
parent8fe6ce0a0b2d2eb02351f38f59f4c11fa5a6a689 (diff)
downloadperlweeklychallenge-club-2a7340b4037ab852921bf0b804ed4cade0044dfe.tar.gz
perlweeklychallenge-club-2a7340b4037ab852921bf0b804ed4cade0044dfe.tar.bz2
perlweeklychallenge-club-2a7340b4037ab852921bf0b804ed4cade0044dfe.zip
Merge pull request #12869 from wanderdoc/master
pwc 343 (wanderdoc)
-rw-r--r--challenge-343/wanderdoc/perl/ch-1.pl74
-rw-r--r--challenge-343/wanderdoc/perl/ch-2.pl146
2 files changed, 220 insertions, 0 deletions
diff --git a/challenge-343/wanderdoc/perl/ch-1.pl b/challenge-343/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..4fa3b74357
--- /dev/null
+++ b/challenge-343/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,74 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given a list of numbers.
+Find the number that is closest to zero and return its distance to zero.
+
+Example 1
+
+Input: @nums = (4, 2, -1, 3, -2)
+Output: 1
+
+Values closest to 0: -1 and 2 (distance = 1 and 2)
+
+
+Example 2
+
+Input: @nums = (-5, 5, -3, 3, -1, 1)
+Output: 1
+
+Values closest to 0: -1 and 1 (distance = 1)
+
+
+Example 3
+
+Input: @ums = (7, -3, 0, 2, -8)
+Output: 0
+
+Values closest to 0: 0 (distance = 0)
+Exact zero wins regardless of other close values.
+
+
+Example 4
+
+Input: @nums = (-2, -5, -1, -8)
+Output: 1
+Values closest to 0: -1 and -2 (distance = 1 and 2)
+
+
+Example 5
+
+Input: @nums = (-2, 2, -4, 4, -1, 1)
+Output: 1
+
+Values closest to 0: -1 and 1 (distance = 1)
+=cut
+
+
+use List::Util qw(first);
+use Test2::V0 -no_srand => 1;
+
+is(closest_to_zero(4, 2, -1, 3, -2), 1, 'Example 1');
+is(closest_to_zero(-5, 5, -3, 3, -1, 1), 1, 'Example 2');
+is(closest_to_zero(7, -3, 0, 2, -8), 0, 'Example 3');
+is(closest_to_zero(-2, -5, -1, -8), 1, 'Example 4');
+is(closest_to_zero(-2, 2, -4, 4, -1, 1), 1, 'Example 5');
+done_testing();
+
+sub closest_to_zero
+{
+ my @nums = @_;
+ if ( defined first { $_ == 0 } @nums )
+ {
+ return 0;
+ }
+ my $min = ~0+1;
+ for my $num ( @nums )
+ {
+ $min = $min < abs($num) ? $min : abs($num);
+ }
+ return $min;
+
+}
diff --git a/challenge-343/wanderdoc/perl/ch-2.pl b/challenge-343/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..584c071616
--- /dev/null
+++ b/challenge-343/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,146 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+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.)
+
+Example 1
+
+Input: @grid = (
+ [0, 1, 1],
+ [0, 0, 1],
+ [0, 0, 0],
+ )
+Output: Team 0
+
+[0, 1, 1] => Team 0 beats Team 1 and Team 2
+[0, 0, 1] => Team 1 beats Team 2
+[0, 0, 0] => Team 2 loses to all
+
+
+Example 2
+
+Input: @grid = (
+ [0, 1, 0, 0],
+ [0, 0, 0, 0],
+ [1, 1, 0, 0],
+ [1, 1, 1, 0],
+ )
+Output: Team 3
+
+[0, 1, 0, 0] => Team 0 beats only Team 1
+[0, 0, 0, 0] => Team 1 loses to all
+[1, 1, 0, 0] => Team 2 beats Team 0 and Team 1
+[1, 1, 1, 0] => Team 3 beats everyone
+
+
+Example 3
+
+Input: @grid = (
+ [0, 1, 0, 1],
+ [0, 0, 1, 1],
+ [1, 0, 0, 0],
+ [0, 0, 1, 0],
+ )
+Output: Team 0
+
+[0, 1, 0, 1] => Team 0 beats teams 1 and 3
+[0, 0, 1, 1] => Team 1 beats teams 2 and 3
+[1, 0, 0, 0] => Team 2 beats team 0
+[0, 0, 1, 0] => Team 3 beats team 2
+
+Of the teams with 2 wins, Team 0 beats team 1.
+
+
+Example 4
+
+Input: @grid = (
+ [0, 1, 1],
+ [0, 0, 0],
+ [0, 1, 0],
+ )
+Output: Team 0
+
+[0, 1, 1] => Team 0 beats Team 1 and Team 2
+[0, 0, 0] => Team 1 loses to Team 2
+[0, 1, 0] => Team 2 beats Team 1 but loses to Team 0
+
+
+Example 5
+
+Input: @grid = (
+ [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],
+ )
+Output: Team 2
+
+[0, 0, 0, 0, 0] => Team 0 loses to all
+[1, 0, 0, 0, 0] => Team 1 beats only Team 0
+[1, 1, 0, 1, 1] => Team 2 beats everyone except self
+[1, 1, 0, 0, 0] => Team 3 loses to Team 2
+[1, 1, 0, 1, 0] => Team 4 loses to Team 2
+
+=cut
+
+
+
+use List::Util qw(sum max);
+use Test2::V0 -no_srand => 1;
+is(champion_team([0, 1, 1],
+ [0, 0, 1],
+ [0, 0, 0]), 0, 'Example 1');
+is(champion_team([0, 1, 0, 0],
+ [0, 0, 0, 0],
+ [1, 1, 0, 0],
+ [1, 1, 1, 0]), 3, 'Example 2');
+
+is(champion_team([0, 1, 0, 1],
+ [0, 0, 1, 1],
+ [1, 0, 0, 0],
+ [0, 0, 1, 0]), 0, 'Example 3');
+is(champion_team([0, 1, 1],
+ [0, 0, 0],
+ [0, 1, 0]), 0, 'Example 4');
+is(champion_team([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, 'Example 5');
+
+done_testing();
+
+
+sub champion_team
+{
+ my @grid = @_;
+ my %results;
+ for my $i ( 0 .. $#grid )
+ {
+ my $sum = sum(@{$grid[$i]});
+ $results{$i} = $sum;
+ }
+ my $max = max(values %results);
+ my @tied = grep { $results{$_} == $max } keys %results;
+ if ( scalar(@tied) == 1 ) { return $tied[0];}
+
+ my %results_tied;
+ for my $first ( @tied )
+ {
+ for my $second ( @tied )
+ {
+ $results_tied{$first} += $grid[$first][$second];
+ }
+ }
+ my $max_tied = max( values %results_tied );
+ my @wins = grep { $results_tied{$_} == $max_tied } keys %results_tied;
+ return wantarray ? @wins : "@wins"; # tied is still possible.
+}