Add Perl solution

5 files changed, 158 insertions, 0 deletions

diff --git a/challenge-249/paulo-custodio/Makefile b/challenge-249/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-249/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-249/paulo-custodio/perl/ch-1.pl b/challenge-249/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..54f7c9c593
--- /dev/null
+++ b/challenge-249/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+
+# Challenge 249
+#
+# Task 1: Equal Pairs
+# Submitted by: Mohammad S Anwar
+#
+# You are given an array of integers with even number of elements.
+#
+# Write a script to divide the given array into equal pairs such that:
+#
+# a) Each element belongs to exactly one pair.
+# b) The elements present in a pair are equal.
+#
+#
+# Example 1
+#
+# Input: @ints = (3, 2, 3, 2, 2, 2)
+# Output: (2, 2), (3, 3), (2, 2)
+#
+# There are 6 elements in @ints.
+# They should be divided into 6 / 2 = 3 pairs.
+# @ints is divided into the pairs (2, 2), (3, 3), and (2, 2) satisfying all the conditions.
+#
+# Example 2
+#
+# Input: @ints = (1, 2, 3, 4)
+# Output: ()
+#
+# There is no way to divide @ints 2 pairs such that the pairs satisfy every condition.
+
+use Modern::Perl;
+
+my @pairs = make_pairs(@ARGV);
+print_pairs(@pairs);
+
+sub make_pairs {
+    my(@ints) = @_;
+    my @pairs;
+    if (@ints == 0 || (@ints % 2) == 1) {
+        return ();
+    }
+pair:
+    while (@ints) {
+        my $a = 0;
+        for my $b (1 .. $#ints) {
+            if ($ints[$a] == $ints[$b]) {
+                push @pairs, [$ints[$a], $ints[$b]];
+                splice @ints, $b, 1;
+                shift @ints;
+                next pair;
+            }
+        }
+        return ();
+    }
+    return @pairs;
+}
+
+sub print_pairs {
+    my(@pairs) = @_;
+    if (@pairs) {
+        say join ", ", map {"(".$_->[0].", ".$_->[1].")"} @pairs;
+    }
+    else {
+        say "()";
+    }
+
+}
diff --git a/challenge-249/paulo-custodio/perl/ch-2.pl b/challenge-249/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..c8a710804a
--- /dev/null
+++ b/challenge-249/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl
+
+# Challenge 249
+#
+# Task 2: DI String Match
+# Submitted by: Mohammad S Anwar
+#
+# You are given a string s, consisting of only the characters "D" and "I".
+#
+# Find a permutation of the integers [0 .. length(s)] such that for each character s[i] in the string:
+#
+# s[i] == 'I' ⇒ perm[i] < perm[i + 1]
+# s[i] == 'D' ⇒ perm[i] > perm[i + 1]
+#
+#
+# Example 1
+#
+# Input: $str = "IDID"
+# Output: (0, 4, 1, 3, 2)
+#
+# Example 2
+#
+# Input: $str = "III"
+# Output: (0, 1, 2, 3)
+#
+# Example 3
+#
+# Input: $str = "DDI"
+# Output: (3, 2, 0, 1)
+
+use Modern::Perl;
+use Math::Combinatorics;
+
+my @perm = find_permutation(@ARGV);
+say "(", join(", ", @perm), ")";
+
+sub find_permutation {
+    my($s) = @_;
+    my @s = split //, $s;
+    my @n = (0 .. length($s));
+    my $combinat = Math::Combinatorics->new(count => scalar(@n), data => \@n);
+    my @permu;
+    while (@permu = $combinat->next_permutation) {
+        if (check_permu(\@s, \@permu)) {
+            return @permu;
+        }
+    }
+    return ();
+}
+
+sub check_permu {
+    my($s, $permu) = @_;
+    my @s = @$s;
+    my @permu = @$permu;
+
+    for my $i (0 .. $#permu-1) {
+        if (!($s[$i] eq 'I' && $permu[$i] < $permu[$i+1] ||
+              $s[$i] eq 'D' && $permu[$i] > $permu[$i+1])) {
+            return 0;
+        }
+    }
+    return 1;
+}
diff --git a/challenge-249/paulo-custodio/t/test-1.yaml b/challenge-249/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..93a44ba0ed
--- /dev/null
+++ b/challenge-249/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,10 @@
+- setup:
+  cleanup:
+  args:     3 2 3 2 2 2
+  input:
+  output:   (3, 3), (2, 2), (2, 2)
+- setup:
+  cleanup:
+  args:     1 2 3 4
+  input:
+  output:   ()
diff --git a/challenge-249/paulo-custodio/t/test-2.yaml b/challenge-249/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..5c50228af8
--- /dev/null
+++ b/challenge-249/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,15 @@
+- setup:
+  cleanup:
+  args:     IDID
+  input:
+  output:   (0, 2, 1, 4, 3)
+- setup:
+  cleanup:
+  args:     III
+  input:
+  output:   (0, 1, 2, 3)
+- setup:
+  cleanup:
+  args:     DDI
+  input:
+  output:   (2, 1, 0, 3)