Merge pull request #9229 from pme/challenge-247

challenge-247

2 files changed, 177 insertions, 0 deletions

diff --git a/challenge-247/peter-meszaros/perl/ch-1.pl b/challenge-247/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..9527af57a6
--- /dev/null
+++ b/challenge-247/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,122 @@
+#!/usr/bin/env perl
+#
+# Secret Santa is a Christmas tradition in which members of a group are
+# randomly assigned a person to whom they give a gift.
+# 
+# You are given a list of names. Write a script that tries to team persons from
+# different families.
+# Example 1
+# 
+# The givers are randomly chosen but don't share family names with the
+# receivers.
+# 
+# Input: @names = ('Mr. Wall',
+#                  'Mrs. Wall',
+#                  'Mr. Anwar',
+#                  'Mrs. Anwar',
+#                  'Mr. Conway',
+#                  'Mr. Cross',
+#                 );
+# 
+# Output:
+# 
+#     Mr. Conway -> Mr. Wall
+#     Mr. Anwar  -> Mrs. Wall
+#     Mrs. Wall  -> Mr. Anwar
+#     Mr. Cross  -> Mrs. Anwar
+#     Mr. Wall   -> Mr. Conway
+#     Mrs. Anwar -> Mr. Cross
+# 
+# Example 2
+# 
+# One gift is given to a family member.
+# 
+# Input: @names = ('Mr. Wall',
+#                  'Mrs. Wall',
+#                  'Mr. Anwar',
+#                 );
+# 
+# Output:
+# 
+#     Mr. Anwar -> Mr. Wall
+#     Mr. Wall  -> Mrs. Wall
+#     Mrs. Wall -> Mr. Anwar
+
+
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+use Algorithm::Combinatorics qw/combinations/;
+
+my $cases = [
+    ['Mr. Wall',
+     'Mrs. Wall',
+     'Mr. Anwar',
+     'Mrs. Anwar',
+     'Mr. Conway',
+     'Mr. Cross',
+    ],
+    ['Mr. Wall',
+     'Mrs. Wall',
+     'Mr. Anwar',
+    ],
+];
+
+sub secret_santa
+{
+    my $names = shift;
+
+	# generate all possible actions
+    my @actions;
+    for my $p1 (@$names) {
+        my ($t1, $n1) = split(' ', $p1);
+        for my $p2 (@$names) {
+            next if $p1 eq $p2;
+            my ($t2, $n2) = split(' ', $p2);
+            next if $n1 eq $n2;
+            push @actions, [$p1, $p2];
+        }
+    }
+
+	# generate all possible actions sets
+	my $ret = 0;
+    my $iter = combinations(\@actions, scalar @$names);
+    while (my $c = $iter->next) {
+		my %stat = map { $_ => []} @$names;
+
+		# collect statistics on actions
+		for my $action (@$c) {
+			my ($n0, $n1) = @$action;
+			$stat{$n0}->[0]++;
+			$stat{$n1}->[1]++;
+		}
+
+		# evaluate statistics
+		my $ok = 1;
+		for my $k (keys %stat) {
+			my ($v1, $v2) = $stat{$k}->@*;
+			if (!defined $v1 or $v1 != 1 or !defined $v2 or $v2 != 1) {
+				$ok = 0;
+				last;
+			}
+		}
+		# print the winner
+		if ($ok) {
+			for my $action (@$c) {
+				my ($n0, $n1) = @$action;
+				print "$n0 -> $n1\n";
+			}
+			$ret = 1;
+			last;
+		}
+    }
+
+    return $ret;
+}
+
+is(secret_santa($cases->[0]), 1, 'big set');
+is(secret_santa($cases->[1]), 0, 'small set');
+done_testing();
+
+exit 0;
diff --git a/challenge-247/peter-meszaros/perl/ch-2.pl b/challenge-247/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..1fc9363f1c
--- /dev/null
+++ b/challenge-247/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/env perl
+#
+# You are given a string S of lower case letters 'a'..'z'.
+# 
+# Write a script that finds the pair of consecutive letters in S that appears
+# most frequently. If there is more than one such pair, chose the one that is the
+# lexicographically first.
+# Example 1
+# 
+# Input: $s = 'abcdbca'
+# Output: 'bc'
+# 
+# 'bc' appears twice in `$s`
+# 
+# Example 2
+# 
+# Input: $s = 'cdeabeabfcdfabgcd'
+# Output: 'ab'
+# 
+# 'ab' and 'cd' both appear three times in $s and 'ab' is lexicographically
+# smaller than 'cd'.
+# 
+
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+
+my $cases = [
+	'abcdbca',
+	'cdeabeabfcdfabgcd',
+];
+
+sub most_frequent_pair
+{
+    my $s = shift;
+
+    my @s = split('', $s);
+    my %h;
+    for my $l (0..($#s-1)) {
+        $h{$s[$l].$s[$l+1]}++;
+    }
+    return (sort {$h{$b} == $h{$a} ? 
+					$a cmp $b :
+                    $h{$b} <=> $h{$a}
+				 } keys %h)[0];
+}
+
+is(most_frequent_pair($cases->[0]),  'bc', 'abcdbca');
+is(most_frequent_pair($cases->[1]),  'ab', 'cdeabeabfcdfabgcd');
+done_testing();
+
+exit 0;
+
+