diff options
| author | Mohammad Sajid Anwar <Mohammad.Anwar@yahoo.com> | 2025-10-19 21:15:30 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2025-10-19 21:15:30 +0100 |
| commit | 2a7340b4037ab852921bf0b804ed4cade0044dfe (patch) | |
| tree | 14338934f7ab736213a8da7cd22b4880eb9d594c | |
| parent | bd396320750457f49888b9938e057eac5d59f5f8 (diff) | |
| parent | 8fe6ce0a0b2d2eb02351f38f59f4c11fa5a6a689 (diff) | |
| download | perlweeklychallenge-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.pl | 74 | ||||
| -rw-r--r-- | challenge-343/wanderdoc/perl/ch-2.pl | 146 |
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. +} |
