challenge-234

2 files changed, 122 insertions, 0 deletions

diff --git a/challenge-234/peter-meszaros/perl/ch-1.pl b/challenge-234/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..1b0e495cca
--- /dev/null
+++ b/challenge-234/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+#
+# You are given an array of words made up of alphabetic characters only.
+# 
+# Write a script to return all alphabetic characters that show up in all words
+# including duplicates.
+# Example 1
+# 
+# Input: @words = ("java", "javascript", "julia")
+# Output: ("j", "a")
+# 
+# Example 2
+# 
+# Input: @words = ("bella", "label", "roller")
+# Output: ("e", "l", "l")
+# 
+# Example 3
+# 
+# Input: @words = ("cool", "lock", "cook")
+# Output: ("c", "o")
+# 
+
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+
+my $cases = [
+    ["java", "javascript", "julia"],
+    ["bella", "label", "roller"],
+    ["cool", "lock", "cook"],
+];
+
+sub common_characters
+{
+	my $l = shift;
+
+    my $word = shift @$l;
+    my $len = @$l;
+	my @word = split('', $word);
+    my @res;
+
+    for my $c (@word) {
+		my $cnt = 0;
+		for my $w (@$l) {
+			++$cnt if $w =~ s/$c//;
+		}
+		push @res, $c if $cnt == $len;
+	}
+
+	return \@res;
+}
+
+is_deeply(common_characters($cases->[0]), ["j", "a"],      '["java", "javascript", "julia"]');
+is_deeply(common_characters($cases->[1]), ["e", "l", "l"], '["bella", "label", "roller"]');
+is_deeply(common_characters($cases->[2]), ["c", "o"],      '["cool", "lock", "cook"]');
+done_testing();
+
+exit 0;
diff --git a/challenge-234/peter-meszaros/perl/ch-2.pl b/challenge-234/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..6f191865b4
--- /dev/null
+++ b/challenge-234/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl
+
+# You are given an array of positive integers.
+# 
+# Write a script to find the number of triplets (i, j, k) that satisfies
+# num[i] != num[j], num[j] != num[k] and num[k] != num[i].
+# Example 1
+# 
+# Input: @ints = (4, 4, 2, 4, 3)
+# Ouput: 3
+# 
+# (0, 2, 4) because 4 != 2 != 3
+# (1, 2, 4) because 4 != 2 != 3
+# (2, 3, 4) because 2 != 4 != 3
+# 
+# Example 2
+# 
+# Input: @ints = (1, 1, 1, 1, 1)
+# Ouput: 0
+# 
+# Example 3
+# 
+# Input: @ints = (4, 7, 1, 10, 7, 4, 1, 1)
+# Output: 28
+# 
+# triplets of 1, 4, 7  = 3x2×2 = 12 combinations
+# triplets of 1, 4, 10 = 3×2×1 = 6  combinations
+# triplets of 4, 7, 10 = 2×2×1 = 4  combinations
+# triplets of 1, 7, 10 = 3x2x1 = 6 combinations
+# 
+
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+use Algorithm::Combinatorics qw/combinations/;
+
+my $cases = [
+	[4, 4, 2, 4, 3],
+	[1, 1, 1, 1, 1],
+	[4, 7, 1, 10, 7, 4, 1, 1],
+];
+
+sub unequal_triplets
+{
+	my $l = shift;
+
+	my $cnt = 0;
+	my $iter = combinations([0 .. $#$l], 3);
+    while (my $c = $iter->next) {
+		my @v = $l->@[@$c];
+        ++$cnt if $v[0] != $v[1] and $v[1] != $v[2] and $v[0] != $v[2];
+    }
+
+	return $cnt;
+}
+
+is(unequal_triplets($cases->[0]),  3, '[4, 4, 2, 4, 3]');
+is(unequal_triplets($cases->[1]),  0, '[1, 1, 1, 1, 1]');
+is(unequal_triplets($cases->[2]), 28, '[4, 7, 1, 10, 7, 4, 1, 1]');
+done_testing();
+
+exit 0;