challenge-209

2 files changed, 144 insertions, 0 deletions

diff --git a/challenge-209/peter-meszaros/perl/ch-1.pl b/challenge-209/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..81e852dd67
--- /dev/null
+++ b/challenge-209/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Special Bit Characters
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of binary bits that ends with 0.
+
+Valid sequences in the bit string are:
+
+	[0] -decodes-to-> "a"
+	[1, 0] -> "b"
+	[1, 1] -> "c"
+
+Write a script to print 1 if the last character is an "a" otherwise print 0.
+
+=head2 Example 1
+
+	Input: @bits = (1, 0, 0)
+	Output: 1
+
+	The given array bits can be decoded as 2-bits character (10) followed by 1-bit
+	character (0).
+
+=head2 Example 2
+
+	Input: @bits = (1, 1, 1, 0)
+	Output: 0
+
+	Possible decode can be 2-bits character (11) followed by 2-bits character (10)
+	i.e. the last character is not 1-bit character.
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+	[[1, 0, 0],       1, 'Example 1'],
+	[[1, 1, 1, 0],    0, 'Example 2'],
+	[[1, 1, 0, 1, 0], 0, 'Example 3'],
+];
+
+sub special_bit_characters
+{
+    my $l = shift;
+
+    my @l = split /(10|11)/, join('', @$l);
+    return ($l[-1] == 0) ? 1 : 0;
+}
+
+for (@$cases) {
+    is(special_bit_characters($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-209/peter-meszaros/perl/ch-2.pl b/challenge-209/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..b1d9cbf2be
--- /dev/null
+++ b/challenge-209/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,85 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Merge Account
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of accounts i.e. name with list of email addresses.
+
+Write a script to merge the accounts where possible. The accounts can only be
+merged if they have at least one email address in common.
+
+=head2 Example 1:
+
+    Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
+                         ["B", "b1@b.com"],
+                         ["A", "a3@a.com", "a1@a.com"] ]
+                       ]
+
+    Output: [ ["A", "a1@a.com", "a2@a.com", "a3@a.com"],
+              ["B", "b1@b.com"] ]
+
+=head2 Example 2:
+
+    Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
+                         ["B", "b1@b.com"],
+                         ["A", "a3@a.com"],
+                         ["B", "b2@b.com", "b1@b.com"] ]
+
+    Output: [ ["A", "a1@a.com", "a2@a.com"],
+              ["A", "a3@a.com"],
+              ["B", "b1@b.com", "b2@b.com"] ]
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+use List::MoreUtils qw/duplicates uniq/;
+
+my $cases = [
+    [[['A', 'a1@a.com', 'a2@a.com'],
+      ['B', 'b1@b.com'],
+      ['A', 'a3@a.com', 'a1@a.com']],
+     [['A', 'a1@a.com', 'a2@a.com', 'a3@a.com'],
+      ['B', 'b1@b.com']], 'Example 1'],
+
+    [[['A', 'a1@a.com', 'a2@a.com'],
+      ['B', 'b1@b.com'],
+      ['A', 'a3@a.com'],
+      ['B', 'b2@b.com', 'b1@b.com']],
+     [['A', 'a1@a.com', 'a2@a.com'],
+      ['A', 'a3@a.com'],
+      ['B', 'b1@b.com', 'b2@b.com']], 'Example 2'],
+];
+
+sub merge_account
+{
+    my $loa = shift; # list of accounts
+
+    my @res = $loa->[0];
+
+    for my $i (1 .. $#$loa) {
+        my ($id1, @l1) = $loa->[$i]->@*;
+        my $join = 1;
+        for my $j (0 .. $#res) {
+            my ($id2, @l2) = $res[$j]->@*;
+            if ($id1 eq $id2 && duplicates(@l1, @l2)) {
+                push $res[$j]->@*, @l1;
+                $res[$j] = [uniq sort $res[$j]->@*];
+                $join = 0;
+                last;
+            }
+        }
+        push @res, $loa->[$i] if $join;
+    }
+    return [sort {$a->[0] cmp $b->[0]} @res];
+}
+
+for (@$cases) {
+    is(merge_account($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;