diff options
| author | Mohammad Sajid Anwar <mohammad.anwar@yahoo.com> | 2024-07-11 22:53:23 +0100 |
|---|---|---|
| committer | Mohammad Sajid Anwar <mohammad.anwar@yahoo.com> | 2024-07-11 22:53:23 +0100 |
| commit | bf4eb71a4e5ef70445e3319aba7e9666235a1ecf (patch) | |
| tree | c0f7224ae6be1a779b8b07ca3edb337f8ab9afb3 /challenge-277 | |
| parent | fdec0681cd0d80c15bf6bf6d8fbbaa3886bd02d5 (diff) | |
| download | perlweeklychallenge-club-bf4eb71a4e5ef70445e3319aba7e9666235a1ecf.tar.gz perlweeklychallenge-club-bf4eb71a4e5ef70445e3319aba7e9666235a1ecf.tar.bz2 perlweeklychallenge-club-bf4eb71a4e5ef70445e3319aba7e9666235a1ecf.zip | |
- Added solutions by Wanderdoc.
Diffstat (limited to 'challenge-277')
| -rwxr-xr-x | challenge-277/wanderdoc/perl/ch-1.pl | 65 | ||||
| -rwxr-xr-x | challenge-277/wanderdoc/perl/ch-2.pl | 51 |
2 files changed, 116 insertions, 0 deletions
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 |