From bf4eb71a4e5ef70445e3319aba7e9666235a1ecf Mon Sep 17 00:00:00 2001
From: Mohammad Sajid Anwar <mohammad.anwar@yahoo.com>
Date: Thu, 11 Jul 2024 22:53:23 +0100
Subject: - Added solutions by Wanderdoc.

---
 challenge-277/wanderdoc/perl/ch-1.pl | 65 ++++++++++++++++++++++++++++++++++++
 challenge-277/wanderdoc/perl/ch-2.pl | 51 ++++++++++++++++++++++++++++
 2 files changed, 116 insertions(+)
 create mode 100755 challenge-277/wanderdoc/perl/ch-1.pl
 create mode 100755 challenge-277/wanderdoc/perl/ch-2.pl

(limited to 'challenge-277')

diff --git a/challenge-277/wanderdoc/perl/ch-1.pl b/challenge-277/wanderdoc/perl/ch-1.pl
new file mode 100755
index 0000000000..ba281224db
--- /dev/null
+++ b/challenge-277/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,65 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+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.
+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.
+
+Example 2
+
+Input: @words1 = ("Perl", "and", "Python", "are", "very", "similar")
+       @words2 = ("Python", "is", "top", "in", "guest", "languages")
+Output: 1
+
+Example 3
+
+Input: @words1 = ("Perl", "is", "imperative", "Lisp", "is", "functional")
+       @words2 = ("Crystal", "is", "similar", "to", "Ruby")
+Output: 0
+=cut
+
+use Test2::V0;
+use Set::Tiny;
+
+is(count_common([("Perl", "is", "my", "friend")], 
+     ["Perl", "and", "Raku", "are", "friend"]), 2, 'Example 1');
+is(count_common([("Perl", "and", "Python", "are", "very", "similar")], 
+     ["Python", "is", "top", "in", "guest", "languages"]), 1, 'Example 2');
+is(count_common([("Perl", "is", "imperative", "Lisp", "is", "functional")], 
+     ["Crystal", "is", "similar", "to", "Ruby"]), 0, 'Example 3');
+
+
+is (count_common([qw(Fear is the path to the dark side)],
+     [qw(Fear leads to anger)], [qw(Anger leads to hate)],
+     [qw(Hate leads to suffering)]), 1, 'Example Yoda');
+done_testing();     
+
+sub count_common
+{
+     my @word_groups = @_;
+     my $data;
+     for my $idx (0 .. $#word_groups)
+     {
+          my %freq;
+          do ($freq{$_}++) for @{$word_groups[$idx]};
+          $data->[$idx] = \%freq;
+     }
+
+     my $s0 = Set::Tiny->new( grep $data->[0]{$_} == 1, keys %{$data->[0]});
+
+     for my $idx ( 1 .. $#$data )
+     {
+          my $s_next = Set::Tiny->new(grep $data->[$idx]{$_} == 1, keys %{$data->[$idx]});
+          $s0 = $s0->intersection($s_next);
+     }
+     return scalar $s0->members;
+}
\ No newline at end of file
diff --git a/challenge-277/wanderdoc/perl/ch-2.pl b/challenge-277/wanderdoc/perl/ch-2.pl
new file mode 100755
index 0000000000..11b9ef6894
--- /dev/null
+++ b/challenge-277/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,51 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+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).
+
+Example 1
+
+Input: @ints = (1, 2, 3, 4, 5)
+Ouput: 4
+
+Strong Pairs: (2, 3), (2, 4), (3, 4), (3, 5)
+
+Example 2
+
+Input: @ints = (5, 7, 1, 7)
+Ouput: 1
+
+Strong Pairs: (5, 7)
+=cut
+
+use Algorithm::Combinatorics qw(combinations);
+use List::Util qw(min);
+use Test2::V0;
+
+is(strong_pairs(1, 2, 3, 4, 5), 4, 'Example 1');
+is(strong_pairs(5, 7, 1, 7), 1, 'Example 2');
+done_testing();
+
+sub strong_pairs
+{
+     my @arr = @_;
+     @arr = sort { $a <=> $b } @arr;
+     my %output;
+     my $iter = combinations(\@arr, 2);
+     while (my $p = $iter->next) 
+     {
+          my ($x, $y) = @$p;
+          if ( abs($x - $y) > 0 and abs($x - $y) < min($x, $y) )
+          {
+               # print join(" ", $x, $y), $/;
+               $output{ join(" ", $x, $y) }++;
+          }
+     }
+     return scalar keys %output;
+}
\ No newline at end of file
-- 
cgit