Merge pull request #9225 from jeanluc2020/jeanluc-247

Add solution 247

4 files changed, 166 insertions, 0 deletions

diff --git a/challenge-247/jeanluc2020/blog-1.txt b/challenge-247/jeanluc2020/blog-1.txt
new file mode 100644
index 0000000000..a1594d1d94
--- /dev/null
+++ b/challenge-247/jeanluc2020/blog-1.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-247-1.html
diff --git a/challenge-247/jeanluc2020/blog-2.txt b/challenge-247/jeanluc2020/blog-2.txt
new file mode 100644
index 0000000000..dcd5376ede
--- /dev/null
+++ b/challenge-247/jeanluc2020/blog-2.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-247-2.html
diff --git a/challenge-247/jeanluc2020/perl/ch-1.pl b/challenge-247/jeanluc2020/perl/ch-1.pl
new file mode 100755
index 0000000000..28a758d523
--- /dev/null
+++ b/challenge-247/jeanluc2020/perl/ch-1.pl
@@ -0,0 +1,109 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-247/#TASK1
+#
+# Task 1: Secret Santa
+# ====================
+#
+# Task 1: Secret Santa
+# Submitted by: Andreas Voegele
+#
+# 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
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# We create all possible permutations for the input. Then we
+# eliminate all of those that have two people of the same family
+# next to each other. Then we select one of the remaining
+# permutations randomly.
+
+use strict;
+use warnings;
+use Data::Dumper;
+use Algorithm::Permute;
+
+secret_santa('Mr. Wall', 'Mrs. Wall', 'Mr. Anwar', 'Mrs. Anwar', 'Mr. Conway', 'Mr. Cross');
+secret_santa('Mr. Wall', 'Mrs. Wall', 'Mr. Anwar');
+
+sub secret_santa {
+   my @names = @_;
+   my @permutations = ();
+   my $p_iterator = Algorithm::Permute->new ( \@names );
+   my @current_permutation;
+   while (my @perm = $p_iterator->next) {
+      @current_permutation = @perm;
+      if(valid(@perm)) {
+         push @permutations, [@perm];
+      }
+   }
+   print Dumper \@permutations;
+   unless(@permutations) {
+      push @permutations, [ @current_permutation ];
+   }
+   my $which = int(rand(scalar(@permutations)));
+   my $permutation = $permutations[$which];
+   my $last = shift @$permutation;
+   push @$permutation, $last;
+   foreach my $who (@$permutation) {
+      print "$last -> $who\n";
+      $last = $who;
+   }
+}
+
+sub valid {
+   my @perm = @_;
+   my $last = shift @perm;
+   push @perm, $last;
+   foreach my $name (@perm) {
+      my $family_last = $last;
+      $family_last =~ s/.* //;
+      my $family_this = $name;
+      $family_this =~ s/.* //;
+      return 0 if $family_last eq $family_this;
+      $last = $name;
+   }
+   return 1;
+}
diff --git a/challenge-247/jeanluc2020/perl/ch-2.pl b/challenge-247/jeanluc2020/perl/ch-2.pl
new file mode 100755
index 0000000000..e697827a3c
--- /dev/null
+++ b/challenge-247/jeanluc2020/perl/ch-2.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-247/#TASK2
+#
+# Task 2: Most Frequent Letter Pair
+# =================================
+#
+# 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'.
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# Create a map with all substrings as keys and their frequency as value,
+# then sort by frequency descending and then by key ascending and return
+# the first element of the sorted list
+
+use strict;
+use warnings;
+
+most_frequent_letter_pair('abcdbca');
+most_frequent_letter_pair('cdeabeabfcdfabgcd');
+
+sub most_frequent_letter_pair {
+   my $s = shift;
+   print "Input: $s\n";
+   my @letters = split //, $s;
+   my $map = {};
+   foreach my $i (0..$#letters-1) {
+      my $new = $letters[$i] . $letters[$i+1];
+      $map->{$new}++;
+   }
+   my @sorted = sort { $map->{$b} <=> $map->{$a} || $a cmp $b } keys %$map;
+   print "Output: $sorted[0]\n";
+}