From 75170ac0736441adc469a25ba6b06b246680220f Mon Sep 17 00:00:00 2001
From: KjetilS <kjetilskotheim@gmail.com>
Date: Thu, 11 Jul 2024 01:51:55 +0200
Subject: https://theweeklychallenge.org/blog/perl-weekly-challenge-277/

---
 challenge-277/kjetillll/perl/ch-1.pl | 26 ++++++++++++++++++++++++++
 challenge-277/kjetillll/perl/ch-2.pl | 16 ++++++++++++++++
 2 files changed, 42 insertions(+)
 create mode 100644 challenge-277/kjetillll/perl/ch-1.pl
 create mode 100644 challenge-277/kjetillll/perl/ch-2.pl

diff --git a/challenge-277/kjetillll/perl/ch-1.pl b/challenge-277/kjetillll/perl/ch-1.pl
new file mode 100644
index 0000000000..c1e4604e84
--- /dev/null
+++ b/challenge-277/kjetillll/perl/ch-1.pl
@@ -0,0 +1,26 @@
+use strict; use warnings;
+
+sub count_common {
+    my @lists = @_;
+    my %count;
+    for my $i ( 0 .. @lists-1 ) {
+        for my $word ( @{ $lists[$i] } ) {
+            $count{$word}{$i}++
+        }
+    }
+    my $onestring = join ' ', (1) x @_;
+    0 + grep join(' ',values %{ $count{$_} }) eq $onestring, sort keys %count;
+}
+
+#---------------------------------------- tests
+use Test::More tests=>3;
+is count_common( @$_{'words1','words2'} ), $$_{output}
+    for { words1 => ["Perl", "is", "my", "friend"],
+          words2 => ["Perl", "and", "Raku", "are", "friend"],
+          output => 2 }, # "Perl" and "friend" appear once in each array.
+        { words1 => ["Perl", "and", "Python", "are", "very", "similar"],
+          words2 => ["Python", "is", "top", "in", "guest", "languages"],
+          output => 1 }, # "Python" appear once in each array
+        { words1 => ["Perl", "is", "imperative", "Lisp", "is", "functional"],
+          words2 => ["Crystal", "is", "similar", "to", "Ruby"],
+          output => 0 }; # "is" appear in both arrays but twice in word1
diff --git a/challenge-277/kjetillll/perl/ch-2.pl b/challenge-277/kjetillll/perl/ch-2.pl
new file mode 100644
index 0000000000..9a2b31712b
--- /dev/null
+++ b/challenge-277/kjetillll/perl/ch-2.pl
@@ -0,0 +1,16 @@
+use strict; use warnings;
+use List::Util qw(min uniq);
+use Algorithm::Combinatorics qw(combinations);
+
+sub pairs              { combinations( [uniq @_], 2 ) }
+sub is_strong_pair     { my($x,$y)=@_; 0 < abs($x-$y) < min($x,$y) }
+sub strong_pairs       { grep is_strong_pair(@$_), &pairs }
+sub strong_pairs_count { 0 + &strong_pairs }
+    
+#---------------------------------------- tests
+use Test::More tests=>2;
+ok strong_pairs_count( @{$$_{input}} ) == $$_{output}
+  for { input  => [1, 2, 3, 4, 5],
+        output => 4 }, # Strong Pairs: (2, 3), (3, 4), (3, 5), (4, 5)
+      { input  => [5, 7, 1, 7],
+        output => 1 };
-- 
cgit