Merge pull request #12842 from pjcs00/wk343

Week 343 - No friends among the champions

3 files changed, 93 insertions, 0 deletions

diff --git a/challenge-343/peter-campbell-smith/blog.txt b/challenge-343/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..14c20cfd7f
--- /dev/null
+++ b/challenge-343/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/343
diff --git a/challenge-343/peter-campbell-smith/perl/ch-1.pl b/challenge-343/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..9e9111aed5
--- /dev/null
+++ b/challenge-343/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-10-13
+use utf8;     # Week 343 - task 1 - Zero friend
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+use Encode;
+
+zero_friend(4, 2, -1, 3, -2);
+zero_friend(-5, 5, -3, 3, -1, 1);
+zero_friend(7, -3, 0, 2, -8);
+zero_friend(71.6, -93.4, 102.102, -1000, 41.2, -70.9, 999, 4e6, -1e-3);
+
+# bigger example
+my @ints;
+push @ints, (int(rand(1e6) - 5e5)) / 1e3 for 0 .. 49;
+zero_friend(@ints);
+
+sub zero_friend {
+	
+	# sort by absolute values
+	my @x = sort {abs($a) <=> abs($b)} @_;
+	
+	say qq[\nInput:  ] . join(', ', @_);
+	say qq[Output: ] . abs($x[0]);
+}
diff --git a/challenge-343/peter-campbell-smith/perl/ch-2.pl b/challenge-343/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..a359a29555
--- /dev/null
+++ b/challenge-343/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2025-10-13
+use utf8;     # Week 343 - task 2 - Champion team
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+use Encode;
+
+champion_team([[0, 1, 1], [0, 0, 1], [0, 0, 0]]);
+champion_team([[0, 1, 0, 0], [0, 0, 0, 0], [1, 1, 0, 0], [1, 1, 1, 0]]);
+champion_team([[0, 1, 0, 1], [0, 0, 1, 1], [1, 0, 0, 0], [0, 0, 1, 0]] );
+champion_team([[0, 1, 1], [0, 0, 0], [0, 1, 0]] );
+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]] );
+
+sub champion_team {
+	
+	my ($m, $n, $most_wins, $team, $result, $wins, $winner);
+	
+	# initialise
+	$m = $_[0];
+	$n = @{$m} - 1;
+	$most_wins = -1;
+	
+	# loop over teams
+	for $team (0 .. $n) {
+		$wins = 0;
+		
+		# loop over results for total wins
+		for $result (0 .. $n) {
+			$wins += $m->[$team]->[$result];
+		}
+		
+		# if this is best so far
+		if ($wins > $most_wins) {
+			$winner = $team;
+			$most_wins = $wins;	
+			
+		# if this equals best so far and this team
+		#  beat the current winner
+		} elsif ($wins == $most_wins and $m->[$team]->[$winner]) {
+			$winner = $team;
+		}
+	}
+	
+	# report
+	say ''; print_matrix(qq[Input: ], $m);
+	say qq[Output: winner is team $winner with $most_wins wins];
+}
+
+sub print_matrix {
+	
+	my ($legend, $matrix, $j);
+
+	# format matrix
+	($legend, $matrix) = @_;
+	for $j (0 .. @$matrix - 1) {
+		print qq{$legend [} . join(', ', @{$matrix->[$j]}) . qq(]);
+		say $j == @$matrix - 1 ? '' : ', ';
+		$legend = ' ' x length($legend);
+	}
+}
+