Merge pull request #9293 from pme/challenge-249

challenge-249

2 files changed, 154 insertions, 0 deletions

diff --git a/challenge-249/peter-meszaros/perl/ch-1.pl b/challenge-249/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..0caeece62f
--- /dev/null
+++ b/challenge-249/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+#
+# 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 strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+use Algorithm::Combinatorics qw/partitions/;
+
+my $cases = [
+	[3, 2, 3, 2, 2, 2],
+	[1, 2, 3, 4],
+];
+
+sub equal_pairs
+{
+    my $l = shift;
+
+    return undef if @$l % 2;
+    my @res;
+    my $len = @$l / 2;
+    my $iter = partitions($l, $len);
+    PARTITION: while (my $p = $iter->next) {
+        undef @res;
+        for (0..$len-1) {
+            my @tuple = $p->[$_]->@*;
+            next PARTITION unless @tuple == 2 and $tuple[0] == $tuple[1];
+            push @res, \@tuple;
+        }
+        if (@res == $len ) {
+            @res = sort {$a->[0] <=> $b->[0]} @res;
+            last;
+        }
+    }
+
+	return \@res;
+}
+
+is_deeply(equal_pairs($cases->[0]), [[2, 2], [2, 2], [3, 3]], '[3, 2, 3, 2, 2, 2]');
+is_deeply(equal_pairs($cases->[1]), []                      , '[1, 2, 3, 4]');
+done_testing();
+
+exit 0;
diff --git a/challenge-249/peter-meszaros/perl/ch-2.pl b/challenge-249/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..9698c19525
--- /dev/null
+++ b/challenge-249/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/env perl
+#
+# 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 strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+use Algorithm::Combinatorics qw/permutations/;
+
+my $cases = [
+    'IDID',
+    'III',
+    'DDI',
+];
+
+sub di_string_match
+{
+    my $str = shift;
+
+    my @str = split('', $str);
+
+    my @res;
+    my $iter = permutations([0..length($str)]);
+    PERMUTATION: while (my $p = $iter->next) {
+        for my $i (0..$#str) {
+            next PERMUTATION unless $str[$i] eq 'I' and $p->[$i] < $p->[$i+1] or
+                                    $str[$i] eq 'D' and $p->[$i] > $p->[$i+1];
+        }
+        push @res, $p;
+    }
+    @res = sort {join('-', @$a) cmp join('-', @$b)} @res;
+
+    return \@res;
+}
+
+is_deeply(di_string_match($cases->[0]), [[ 0, 2, 1, 4, 3 ],
+                                         [ 0, 3, 1, 4, 2 ],
+                                         [ 0, 3, 2, 4, 1 ],
+                                         [ 0, 4, 1, 3, 2 ],
+                                         [ 0, 4, 2, 3, 1 ],
+                                         [ 1, 2, 0, 4, 3 ],
+                                         [ 1, 3, 0, 4, 2 ],
+                                         [ 1, 3, 2, 4, 0 ],
+                                         [ 1, 4, 0, 3, 2 ],
+                                         [ 1, 4, 2, 3, 0 ],
+                                         [ 2, 3, 0, 4, 1 ],
+                                         [ 2, 3, 1, 4, 0 ],
+                                         [ 2, 4, 0, 3, 1 ],
+                                         [ 2, 4, 1, 3, 0 ],
+                                         [ 3, 4, 0, 2, 1 ],
+                                         [ 3, 4, 1, 2, 0 ],
+                                        ], 'IDID');
+is_deeply(di_string_match($cases->[1]), [[ 0, 1, 2, 3 ],
+                                        ], 'III');
+is_deeply(di_string_match($cases->[2]), [[ 2, 1, 0, 3 ],
+                                         [ 3, 1, 0, 2 ],
+                                         [ 3, 2, 0, 1 ],
+                                        ], 'DDI');
+done_testing();
+
+exit 0;
+
+