# Perl Weekly Challenge 247.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 247.

# 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
``````

I make a hash mapping full names to family names, and family names to arrays of full names. I sort family names according to their number of members, starting with the most numerous. Then, a solution may be found by circulating families and choosing a different member until depleted. The last receiver gives a gift to the first giver and that is the end. The code fits a 2.5 liner, but the full code is much more comprehensible (actually, I wrote it first and then compressed it).

Example 1:

``````perl -Mexperimental=postderef -E 'while(<>){chomp;(\$u,\$l)=split " ";\$l{\$_}=\$l;push \$p{\$l}->@*, \$_;}
@f=sort {\$p{\$b}->@*<=>\$p{\$a}->@*}keys %p;while(@f){\$h=shift @f;\$g=shift \$p{\$h}->@*;\$p//=\$g;
push @f, \$h if \$p{\$h}->@*;\$r=\$f[0]?\$p{\$f[0]}[0]:\$p;say "\$g -> \$r";}' << END
Mr. Wall
Mrs. Wall
Mr. Anwar
Mrs. Anwar
Mr. Conway
Mr. Cross
END
``````

Results:

``````Mr. Wall -> Mr. Anwar
Mr. Anwar -> Mr. Conway
Mr. Conway -> Mr. Cross
Mr. Cross -> Mrs. Wall
Mrs. Wall -> Mrs. Anwar
Mrs. Anwar -> Mr. Wall
``````

Example 2:

``````perl -Mexperimental=postderef -E 'while(<>){chomp;(\$u,\$l)=split " ";\$l{\$_}=\$l;push \$p{\$l}->@*, \$_;}
@f=sort {\$p{\$b}->@*<=>\$p{\$a}->@*}keys %p;while(@f){\$h=shift @f;\$g=shift \$p{\$h}->@*;\$p//=\$g;
push @f, \$h if \$p{\$h}->@*;\$r=\$f[0]?\$p{\$f[0]}[0]:\$p;say "\$g -> \$r";}' << END
Mr. Wall
Mrs. Wall
Mr. Anwar
END
``````

Results:

``````Mr. Wall -> Mr. Anwar
Mr. Anwar -> Mrs. Wall
Mrs. Wall -> Mr. Wall
``````

The full code follows.

`````` 1  # Perl weekly challenge 247
2  # Task 1:  Secret Santa
3  #
4  # See https://wlmb.github.io/2023/12/11/PWC247/#task-1-secret-santa
5  use v5.36;
6  use experimental qw(postderef);
7  my %last_name;
8  my %person;
9  # Input from STDIN, one name per line
10  while(<>){
11      chomp;
12      my (undef,\$last)=split " ";
13      \$last_name{\$_}=\$last;
14      push \$person{\$last}->@*, \$_;
15  }
16  my @families=sort {\$person{\$b}->@*<=>\$person{\$a}->@*} keys %person;
17  my \$first_giver;
18  while(@families){
19      my \$family_giver=shift @families;
20      my \$giver=shift \$person{\$family_giver}->@*;
21      \$first_giver//=\$giver;
22      push @families, \$family_giver if \$person{\$family_giver}->@*;
24      say "\$giver -> \$receiver";
25  }
``````

Example 1:

``````./ch-1.pl << "END"
Mr. Wall
Mrs. Wall
Mr. Anwar
Mrs. Anwar
Mr. Conway
Mr. Cross
END
``````

Results:

``````Mr. Anwar -> Mr. Wall
Mr. Wall -> Mr. Cross
Mr. Cross -> Mr. Conway
Mr. Conway -> Mrs. Anwar
Mrs. Anwar -> Mrs. Wall
Mrs. Wall -> Mr. Anwar
``````

Example 2:

``````./ch-1.pl << "END"
Mr. Wall
Mrs. Wall
Mr. Anwar
END
``````

Results:

``````Mr. Wall -> Mr. Anwar
Mr. Anwar -> Mrs. Wall
Mrs. Wall -> Mr. Wall
``````

# Task 2: Most Frequent Letter Pair

``````Submitted by: Jorg Sommrey
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'.
``````

One can map the characters of the string into pairs of characters, map the with a hash to their number and sort them. The result fits a two-liner.

Examples:

``````perl -E 'for(@ARGV){@l=split "";\$f=shift @l;\$c{\$_}++ for map{\$n=\$f;\$f=\$_;"\$n\$f"}@l;
@s=sort{\$c{\$b}<=>\$c{\$a}||\$a cmp \$b} keys %c;say "\$_ -> \$s[0]"}' abcdbca cdeabeabfcdfabgcd
``````

Results:

``````abcdbca -> bc
cdeabeabfcdfabgcd -> ab
``````

The full code is similar.

`````` 1  # Perl weekly challenge 247
2  # Task 2:  Most Frequent Letter Pair
3  #
4  # See https://wlmb.github.io/2023/12/11/PWC247/#task-2-most-frequent-letter-pair
5  use v5.36;
6  die <<~"FIN" unless @ARGV;
7      Usage: \$0 S1 [S2...]
8      to find the most frequent pair of consecutive letters
9      from each of the strings S1, S2...
10      FIN
11  for(@ARGV){
12      my @letters=split "";
13      my \$first=shift @letters;
14      my %count;
15      \$count{\$_}++ for map{my \$previous=\$first; \$first=\$_; "\$previous\$first"}@letters;
16      my @sorted =sort{\$count{\$b}<=>\$count{\$a}||\$a cmp \$b} keys %count;
17      say "\$_ -> \$sorted[0]"
18  }
``````

Examples:

``````./ch-2.pl abcdbca cdeabeabfcdfabgcd
``````

Results:

``````abcdbca -> bc
cdeabeabfcdfabgcd -> ab
``````
Written on December 11, 2023