Merge pull request #10525 from rjt-pl/master

rjt's week 277 solutions and blog (belated)

4 files changed, 68 insertions, 6 deletions

diff --git a/challenge-277/ryan-thompson/README.md b/challenge-277/ryan-thompson/README.md
index 588de6d8b1..537f4295ce 100644
--- a/challenge-277/ryan-thompson/README.md
+++ b/challenge-277/ryan-thompson/README.md
@@ -1,17 +1,15 @@
 # Ryan Thompson
 
-## Week 276 Solutions
+## Week 277 Solutions
 
-### Task 1 › Complete Day
+### Task 1 › Count Common
 
  * [Perl](perl/ch-1.pl)
- * [Python](python/ch-1.py)
 
-### Task 2 › Maximum Frequency
+### Task 2 › Strong Pair
 
  * [Perl](perl/ch-2.pl)
- * [Python](python/ch-2.py)
 
 ## Blog
 
- * [Maximum Frequency and now my Day is Complete](https://ry.ca/2024/07/pwc-276-complete-day-and-maximum-frequency/)
+ * [We make a Strong Pair](https://ry.ca/2024/07/pwc-277-strong-pair-counting-common/)
diff --git a/challenge-277/ryan-thompson/blog.txt b/challenge-277/ryan-thompson/blog.txt
new file mode 100644
index 0000000000..01ded8abc3
--- /dev/null
+++ b/challenge-277/ryan-thompson/blog.txt
@@ -0,0 +1 @@
+https://ry.ca/2024/07/pwc-277-strong-pair-counting-common/
diff --git a/challenge-277/ryan-thompson/perl/ch-1.pl b/challenge-277/ryan-thompson/perl/ch-1.pl
new file mode 100644
index 0000000000..9446abbad0
--- /dev/null
+++ b/challenge-277/ryan-thompson/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+#
+# ch-1.pl - Count Common
+#
+# Count of words that appears in both arrays exactly once
+# My version supports an arbitrary number of arrays, instead of just two.
+# Modifying or wrapping it to limit it to two would be trivial.
+# Does NOT sort results by default. This is a minor optimization.
+# Sort if you need stable results.
+#
+# See blog post for more information:
+# https://ry.ca/2024/07/pwc-277-strong-pair-counting-common/
+#
+# 2024 Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+use Carp;
+use List::Util qw< all >;
+no warnings 'uninitialized';
+
+sub count_common {
+    'ARRAY' ne ref and croak 'Arguments must be ARRAY refs' for @_; # VAL
+    my @once; # $once[$idx]{word} = # True if 'word' appears once in $_[$idx]
+
+    for my $i (keys @_) {
+        my %freq; $freq{$_}++ for @{ $_[$i] };
+        $once[$i]{$_} = 1 for grep { $freq{$_} == 1 } keys %freq;
+    }
+    
+    grep { my $w = $_; all { $_->{$w} } @once } keys %{$once[0]}
+}
+
+1;
diff --git a/challenge-277/ryan-thompson/perl/ch-2.pl b/challenge-277/ryan-thompson/perl/ch-2.pl
new file mode 100644
index 0000000000..1e7daecc1f
--- /dev/null
+++ b/challenge-277/ryan-thompson/perl/ch-2.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+#
+# ch-2.pl - Strong Pair
+#
+# Return the count of all strong pairs in the given array
+# A pair of integers is strong if 0 < | x - y | < min(x,y)
+#
+# See blog post for more information:
+# https://ry.ca/2024/07/pwc-277-strong-pair-counting-common/
+#
+# 2024 Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+use Carp;
+use List::Util qw< uniq min >;
+no warnings 'uninitialized';
+
+sub strong_pair {
+    ref || $_ !~ /^\-?\d+$/ and croak 'Arguments must be integers' for @_;
+    my @i = uniq sort { $a <=> $b } @_;
+
+    grep { my ($x,$y) = @$_; $x < $y and $y < 2*$x }
+     map { my $i = $_; map { [ @_[$i,$_] ] } $i+1..$#i } 0..$#i
+}
+
+1;