- Added Perl solutions to the week 189.

2 files changed, 106 insertions, 0 deletions

diff --git a/challenge-189/mohammad-anwar/perl/ch-1.pl b/challenge-189/mohammad-anwar/perl/ch-1.pl
new file mode 100644
index 0000000000..7e0d7f2806
--- /dev/null
+++ b/challenge-189/mohammad-anwar/perl/ch-1.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+=head1
+
+Week 189:
+
+    https://theweeklychallenge.org/blog/perl-weekly-challenge-189
+
+Task #1: Greater Character
+
+    You are given an array of characters (a..z) and a target character.
+
+    Write a script to find out the smallest character in the given
+    array lexicographically greater than the target character.
+
+=cut
+
+use v5.36;
+use Test2::V0;
+
+is greater_character('b', qw/e m u g/, 'b'), 'e', 'Example 1';
+is greater_character('a', qw/d c e f/, 'a'), 'c', 'Example 2';
+is greater_character('o', qw/j a r/  , 'o'), 'r', 'Example 3';
+is greater_character('a', qw/d c a f/, 'a'), 'c', 'Example 4';
+is greater_character('v', qw/t g a l/, 'v'), 'v', 'Example 5';
+
+done_testing;
+
+#
+#
+# METHOD
+
+sub greater_character($t, @chars) {
+    for (sort @chars) { return $_ if ord > ord $t }
+    return $t;
+}
diff --git a/challenge-189/mohammad-anwar/perl/ch-2.pl b/challenge-189/mohammad-anwar/perl/ch-2.pl
new file mode 100644
index 0000000000..9b979eaa2c
--- /dev/null
+++ b/challenge-189/mohammad-anwar/perl/ch-2.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+
+=head1
+
+Week 189:
+
+    https://theweeklychallenge.org/blog/perl-weekly-challenge-189
+
+Task #2: Array Degree
+
+    You are given an array of 2 or more non-negative integers.
+
+    Write a script to find out the smallest subarray having the degree
+    of the given array.
+
+    The degree of an array is the maximum frequence of an element in
+    the array.
+
+=cut
+
+use v5.36;
+use Test2::V0;
+use Algorithm::Combinatorics qw(subsets);
+
+is array_degree(1, 3, 3, 2)   , [3, 3],       'Example 1';
+is array_degree(1, 2, 1, 3)   , [1, 2, 1],    'Example 2';
+is array_degree(1, 3, 2, 1, 2), [2, 1, 2],    'Example 3';
+is array_degree(1, 1, 2, 3, 2), [1, 1],       'Example 4';
+is array_degree(2, 1, 2, 1, 1), [1, 2, 1, 1], 'Example 5';
+
+done_testing;
+
+#
+#
+# METHODS
+
+sub array_degree(@list) {
+    my %h;
+    my $x = join(q{}, @list);
+    my %seen;
+    foreach my $k (2 .. scalar(@list)) {
+        my $entries = subsets(\@list, $k);
+        while (my $entry = $entries->next) {
+            my $y = join(q{}, @$entry);
+            next if $seen{$y};
+            next unless ($x =~ /$y/);
+            $h{ join(":", @$entry) } = _array_degree($entry);
+            $seen{$y} = 1;
+        }
+    }
+
+    my $d = $h{[ sort { $h{$b} <=> $h{$a} } keys %h ]->[0]};
+    my $s = 0;
+    my $r;
+    foreach my $e (keys %h) {
+        if ($h{$e} == $d) {
+            if ($s == 0 || length($e) <= $s) {
+                $r = $e;
+                $s = length($e);
+            }
+        }
+    }
+
+    return [ split /\:/, $r ];
+}
+
+sub _array_degree($data) {
+    my %e; ++$e{$_} for @$data;
+    return $e{[ sort { $e{$b} <=> $e{$a} } keys %e ]->[0]};
+}