challenge-277

2 files changed, 135 insertions, 0 deletions

diff --git a/challenge-277/peter-meszaros/perl/ch-1.pl b/challenge-277/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..d456030b43
--- /dev/null
+++ b/challenge-277/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,74 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Count Common
+
+You are given two array of strings, @words1 and @words2.
+
+Write a script to return the count of words that appears in both arrays exactly
+once.
+
+=head2 Example 1
+
+    Input: @words1 = ("Perl", "is", "my", "friend")
+           @words2 = ("Perl", "and", "Raku", "are", "friend")
+    Output: 2
+
+The words "Perl" and "friend" appear once in each array.
+
+=head2 Example 2
+
+    Input: @words1 = ("Perl", "and", "Python", "are", "very", "similar")
+           @words2 = ("Python", "is", "top", "in", "guest", "languages")
+    Output: 1
+
+=head2 Example 3
+
+    Input: @words1 = ("Perl", "is", "imperative", "Lisp", "is", "functional")
+           @words2 = ("Crystal", "is", "similar", "to", "Ruby")
+    Output: 0
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    [[["Perl", "is", "my", "friend"],
+      ["Perl", "and", "Raku", "are", "friend"]
+     ], 2],
+    [[["Perl", "and", "Python", "are", "very", "similar"],
+      ["Python", "is", "top", "in", "guest", "languages"]
+     ], 1],
+    [[["Perl", "is", "imperative", "Lisp", "is", "functional"],
+      ["Crystal", "is", "similar", "to", "Ruby"]
+     ], 0],
+];
+
+sub count_common
+{
+    my $w1 = $_[0]->[0];
+    my $w2 = $_[0]->[1];
+
+    my %h;
+    for (@$w1) {
+        if (exists $h{$_}) {
+           $h{$_} = -1; 
+        } else {
+           $h{$_}++;
+        }
+    }
+    for (@$w2) {
+        $h{$_}++ if exists $h{$_} and $h{$_} == 1;
+    }
+
+    return scalar grep {$_ == 2} values %h;
+}
+
+for (@$cases) {
+    is(count_common($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-277/peter-meszaros/perl/ch-2.pl b/challenge-277/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..903b82964b
--- /dev/null
+++ b/challenge-277/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Strong Pair
+
+You are given an array of integers, @ints.
+
+Write a script to return the count of all strong pairs in the given array.
+
+    A pair of integers x and y is called strong pair if it satisfies:
+    0 < |x - y| < min(x, y).
+
+=head2 Example 1
+
+    Input: @ints = (1, 2, 3, 4, 5)
+    Ouput: 4
+
+    Strong Pairs: (2, 3), (3, 4), (3, 5), (4, 5)
+
+=head2 Example 2
+
+    Input: @ints = (5, 7, 1, 7)
+    Ouput: 1
+
+    Strong Pairs: (5, 7)
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+use List::Util qw/min uniqint/;
+use Algorithm::Combinatorics qw/combinations/;
+
+my $cases = [
+    [[1, 2, 3, 4, 5], 4],
+    [[5, 7, 1, 7],    1],
+];
+
+sub strong_pair
+{
+    my $ints = shift;
+
+    my $cnt = 0;
+    my $iter = combinations([uniqint @$ints], 2);
+    while (my $c = $iter->next) {
+        my $abs = abs($c->[0] - $c->[1]);
+        my $min = min($c->[0], $c->[1]);
+        $cnt++ if 0 < $abs && $abs < $min;
+    }
+
+    return $cnt;
+}
+
+for (@$cases) {
+    is(strong_pair($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
+