2 files changed, 94 insertions, 0 deletions
diff --git a/challenge-277/dave-jacoby/perl/ch-1.pl b/challenge-277/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..29c6deda87
--- /dev/null
+++ b/challenge-277/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ bitwise fc postderef say signatures state };
+
+use List::Util qw{max};
+
+my @examples = (
+
+    {
+        words1 => [ "Perl", "is",  "my",   "friend" ],
+        words2 => [ "Perl", "and", "Raku", "are", "friend" ],
+    },
+    {
+        words1 => [ "Perl",   "and", "Python", "are", "very",  "similar" ],
+        words2 => [ "Python", "is",  "top",    "in",  "guest", "languages" ],
+    },
+    {
+        words1 => [ "Perl", "is", "imperative", "Lisp", "is", "functional" ],
+        words2 => [ "Crystal", "is", "similar", "to",   "Ruby" ],
+    },
+);
+
+for my $example (@examples) {
+    my $output = common_count($example);
+    my $words1 = join '", "', $example->{words1}->@*;
+    my $words2 = join '", "', $example->{words2}->@*;
+    say <<"END";
+    Input:  \@words1 = ("$words1"), 
+            \@words2 = ("$words2")
+    Output: $output
+END
+}
+
+sub common_count ($input) {
+    my @words1 = $input->{words1}->@*;
+    my @words2 = $input->{words2}->@*;
+    my $hash;
+    map { $hash->{$_}{1}++; $hash->{$_}{2} //= 0 } @words1;
+    map { $hash->{$_}{2}++; $hash->{$_}{1} //= 0 } @words2;
+    return scalar grep { $hash->{$_}{1} == 1 && $hash->{$_}{2} == 1 }
+        keys $hash->%*;
+}
diff --git a/challenge-277/dave-jacoby/perl/ch-2.pl b/challenge-277/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..e82b4e5f29
--- /dev/null
+++ b/challenge-277/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ fc say postderef signatures state };
+
+use List::Util qw{ min };
+
+my @examples = (
+
+    [ 1, 2, 3, 4, 5 ],
+    [ 5, 7, 1, 7 ],
+);
+
+for my $input (@examples) {
+    my @output = strong_pair( $input->@* );
+    my $ints   = join ', ', $input->@*;
+    my $output = scalar @output;
+    my $pairs = join ', ', map { qq{($_)} } map { join ', ', $_->@* } @output;
+
+    say <<"END";
+        Input:  \@ints = ($ints)
+        Output: $output
+
+        Strong Pairs: $pairs
+END
+}
+
+sub strong_pair (@ints) {
+    my @output;
+    my $top = -1 + scalar @ints;
+    for my $i ( 0 .. $top ) {
+        my $x = $ints[$i];
+        for my $j ( $i + 1 .. $top ) {
+            my $y   = $ints[$j];
+            my $abs = abs $x - $y;
+            my $min = min $x, $y;
+            if ( $abs > 0 && $abs < $min ) {
+                my @pair = sort $x, $y;
+                push @output, \@pair;
+            }
+        }
+    }
+
+    # array cleanup - put in order, avoid duplicates
+    my %hash;
+    map { my $x = join ',', @$_; $hash{$x} = $_ } @output;
+    return sort { $a->[0] <=> $b->[0] }
+        sort { $a->[1] <=> $b->[1] } values %hash;
+}