Merge pull request #9241 from packy/master

Challenge 247 solutions by Packy Anderson

8 files changed, 532 insertions, 31 deletions

diff --git a/challenge-247/packy-anderson/README.md b/challenge-247/packy-anderson/README.md
index 3a7012c898..319baacb3d 100644
--- a/challenge-247/packy-anderson/README.md
+++ b/challenge-247/packy-anderson/README.md
@@ -7,13 +7,29 @@
 Sample output
 ```
 $ raku/ch-1.raku
+Example 1:
+Input: @names = ('Mr. Wall',
+                 'Mrs. Wall',
+                 'Mr. Anwar',
+                 'Mrs. Anwar',
+                 'Mr. Conway',
+                 'Mr. Cross')
+Output:
+    Mr. Wall -> Mr. Cross
+    Mrs. Wall -> Mr. Conway
+    Mr. Anwar -> Mr. Wall
+    Mrs. Anwar -> Mrs. Wall
+    Mr. Conway -> Mrs. Anwar
+    Mr. Cross -> Mr. Anwar
+
+Example 2:
+Input: @names = ('Mr. Wall',
+                 'Mrs. Wall',
+                 'Mr. Anwar')
 Output:
-1
-6
-15
-28
-31
-45
+    Mr. Wall -> Mr. Anwar
+    Mrs. Wall -> Mr. Wall
+    Mr. Anwar -> Mrs. Wall
 ```
 
 * [Task 2](raku/ch-2.raku)
@@ -22,19 +38,22 @@ Sample output
 ```
 $ raku/ch-2.raku
 Example 1:
-Input: @a = (1, 1, 2, 3, 5)
-Found integer values for P (1) and Q (1)
-Output: True
+Input: $s = 'abcdbca'
+Output: 'bc'
+
+'bc' appears twice in $s
 
 Example 2:
-Input: @a = (4, 2, 4, 5, 7)
-Values for P (0.5) and Q (1) for first four elements are not integers
-Output: False
+Input: $s = 'cdeabeabfcdfabgcd'
+Output: 'ab'
+
+'ab' and 'cd' appear three times in $s and 'ab' is lexicographically smallest.
 
 Example 3:
-Input: @a = (4, 1, 2, -3, 8)
-Found integer values for P (1) and Q (-2)
-Output: True
+Input: $s = 'abcdeabcde'
+Output: 'ab'
+
+'ab', 'bc', 'cd', and 'de' appear twice in $s and 'ab' is lexicographically smallest.
 ```
 
 ## Perl
@@ -44,13 +63,29 @@ Output: True
 Sample output
 ```
 $ perl/ch-1.pl
+Example 1:
+Input: @names = ('Mr. Wall',
+                 'Mrs. Wall',
+                 'Mr. Anwar',
+                 'Mrs. Anwar',
+                 'Mr. Conway',
+                 'Mr. Cross')
+Output:
+    Mr. Wall -> Mrs. Anwar
+    Mrs. Wall -> Mr. Cross
+    Mr. Anwar -> Mr. Conway
+    Mrs. Anwar -> Mr. Wall
+    Mr. Conway -> Mr. Anwar
+    Mr. Cross -> Mrs. Wall
+
+Example 2:
+Input: @names = ('Mr. Wall',
+                 'Mrs. Wall',
+                 'Mr. Anwar')
 Output:
-3
-7
-26
-27
-29
-44
+    Mr. Wall -> Mr. Anwar
+    Mrs. Wall -> Mr. Wall
+    Mr. Anwar -> Mrs. Wall
 ```
 
 * [Task 2](perl/ch-2.pl)
@@ -59,19 +94,22 @@ Sample output
 ```
 $ perl/ch-2.pl
 Example 1:
-Input: @a = (1, 1, 2, 3, 5)
-Found integer values for P (1) and Q (1)
-Output: true
+Input: $s = 'abcdbca'
+Output: 'bc'
+
+'bc' appears twice in $s
 
 Example 2:
-Input: @a = (4, 2, 4, 5, 7)
-Values for P (0.5) and Q (1) for first four elements are not integers
-Output: false
+Input: $s = 'cdeabeabfcdfabgcd'
+Output: 'ab'
+
+'ab' and 'cd' appear three times in $s and 'ab' is lexicographically smallest.
 
 Example 3:
-Input: @a = (4, 1, 2, -3, 8)
-Found integer values for P (1) and Q (-2)
-Output: true
+Input: $s = 'abcdeabcde'
+Output: 'ab'
+
+'ab', 'bc', 'cd', and 'de' appear twice in $s and 'ab' is lexicographically smallest.
 ```
 
 ## Guest Language: Python
@@ -80,4 +118,4 @@ Output: true
 
 ## Blog Post
 
-[Perl Weekly Challenge: 25 or 6 out of four... ty-nine](https://packy.dardan.com/b/F5)
+[Perl Weekly Challenge: Writing Letter Pairs to Santa](https://packy.dardan.com/b/FK)
diff --git a/challenge-247/packy-anderson/blog.txt b/challenge-247/packy-anderson/blog.txt
new file mode 100644
index 0000000000..1b7701a5d6
--- /dev/null
+++ b/challenge-247/packy-anderson/blog.txt
@@ -0,0 +1 @@
+https://packy.dardan.com/b/FK
\ No newline at end of file
diff --git a/challenge-247/packy-anderson/perl/ch-1.pl b/challenge-247/packy-anderson/perl/ch-1.pl
new file mode 100755
index 0000000000..d3b7fe9d63
--- /dev/null
+++ b/challenge-247/packy-anderson/perl/ch-1.pl
@@ -0,0 +1,73 @@
+#!/usr/bin/env perl
+use v5.38;
+
+use List::Util qw( sample );
+
+sub findRecipient($giver, $recipients) {
+  # since $recipients is a reference to a hash, we can't
+  # modify it, so let's make a copy with the giver removed
+  my @recipients = grep { !/$giver/ } keys %$recipients;
+
+  # split on whitespace and take the last element
+  # to get the "family name"
+  my $family_name = (split /\s+/, $giver)[-1];
+
+  # now, make a potential recipient hash
+  # excluding family members
+  my @non_family_members =
+    grep { !/$family_name/ } @recipients;
+
+  if (@non_family_members > 0) {
+    return sample(1, @non_family_members);
+  }
+  else {
+    return sample(1, @recipients);
+  }
+}
+
+sub secretSanta(@names) {
+  # let's use a hash to hold the giver/recipient pairings
+  my %results;
+ 
+  # put our work in a labelled loop
+  ASSIGN_RECIPIENTS: while () {
+    # convert the array of names into a hash with names as keys
+    my %available_recipients = map { $_ => 1 } @names;
+
+    # now go through each of the names and find a
+    # recipient for them
+    foreach my $giver ( @names ) {
+      my $recipient =
+        findRecipient($giver, \%available_recipients);
+
+      # occasionally, we assign recipients so in the last
+      # iteration of the for loop the only available
+      # recipient is $giver. When that happens, the easiest
+      # way to fix things is to just re-do the entire list
+      redo ASSIGN_RECIPIENTS if ! defined $recipient;
+
+      $results{$giver} = $recipient;
+      delete $available_recipients{$recipient};
+    }
+    last; # exit the labelled loop
+  }
+  return %results;
+}
+
+sub solution(@names) {
+  say "Input: \@names = ('"
+    . join("',\n                 '", @names)
+    . "')";
+  my %recipients = secretSanta(@names);
+  say "Output:";
+  foreach my $giver ( @names ) {
+    say "    $giver -> $recipients{$giver}";
+  }
+}
+
+say "Example 1:";
+solution('Mr. Wall', 'Mrs. Wall', 'Mr. Anwar',
+         'Mrs. Anwar', 'Mr. Conway', 'Mr. Cross');
+
+say "\nExample 2:";
+solution('Mr. Wall', 'Mrs. Wall', 'Mr. Anwar');
\ No newline at end of file
diff --git a/challenge-247/packy-anderson/perl/ch-2.pl b/challenge-247/packy-anderson/perl/ch-2.pl
new file mode 100755
index 0000000000..d386f00f46
--- /dev/null
+++ b/challenge-247/packy-anderson/perl/ch-2.pl
@@ -0,0 +1,77 @@
+#!/usr/bin/env perl
+use v5.38;
+
+use Lingua::EN::Inflexion qw( noun wordlist );
+
+sub pairCount($s) {
+  my %count;
+  while (length($s) > 1) {
+    my $pair = substr($s, 0, 2); # the first two characters
+    $count{$pair}++;        # count the pair
+    $s = substr($s, 1); # remove the first character
+  }
+  return %count;
+}
+
+sub mostFrequentPair($s) {
+  # count the letter pairs
+  my %pairs = pairCount($s);
+
+  # sort the pairs by their counts
+  my @sorted = sort {
+    # sort by count first
+    $pairs{$b} <=> $pairs{$a}
+    ||
+    # then by lexicographical order
+    $a cmp $b
+  } keys %pairs;
+
+  my @max_pair  = shift(@sorted); # pull off first value
+  my $max_count = $pairs{$max_pair[0]}; # get it's count
+
+  while ( $pairs{$sorted[0]} == $max_count ) {
+    # there are pairs on the sorted list that have the
+    # same count, so let's put them on the list, too
+    push @max_pair, shift(@sorted);
+  }
+  my $explain;
+
+  # set aside the pair that sorted to the top
+  my $first_pair = $max_pair[0];
+
+  # now quote all the pairs
+  my $pair_list = wordlist( map { qq{'$_'} } @max_pair );
+
+  # make the count an english word
+  my $count = ($max_count == 1) ? 'once'             # 🎶
+            : ($max_count == 2) ? 'twice'            # 🎶
+            : noun($max_count)->cardinal . ' times'; # a lady 🎶
+
+  # and format the explanation
+  if (@max_pair == 1) {
+    $explain = "'$first_pair' appears $count in \$s";
+  }
+  else {
+    $explain = $pair_list . " appear $count in \$s and "
+             . "'$first_pair' is lexicographically smallest.";
+  }
+
+  return $first_pair, $explain;
+}
+
+sub solution($s) {
+  say "Input: \$s = '$s'";
+  my ($pair, $explain) = mostFrequentPair($s);
+  say "Output: '$pair'";
+  say "";
+  say $explain;
+}
+
+say "Example 1:";
+solution('abcdbca');
+
+say "\nExample 2:";
+solution('cdeabeabfcdfabgcd');
+
+say "\nExample 3:";
+solution('abcdeabcde');
\ No newline at end of file
diff --git a/challenge-247/packy-anderson/python/ch-1.py b/challenge-247/packy-anderson/python/ch-1.py
new file mode 100755
index 0000000000..5c8d4416a9
--- /dev/null
+++ b/challenge-247/packy-anderson/python/ch-1.py
@@ -0,0 +1,71 @@
+#!/usr/bin/env python
+
+from random import sample
+import re
+
+def findRecipient(giver, recipients):
+    # exclude the giver from the recipient list
+    possible_recipients = [
+        name for name in recipients if name != giver
+    ]
+
+    # if there are no possible recipients, bail early
+    if len(recipients) == 0:
+        return None
+
+    # split on whitespace and take the last element
+    # to get the "family name"
+    family_name = re.compile((giver.split())[-1])
+
+    # now, make a potential recipient list
+    # excluding family members
+    non_family_members = [
+        name for name in possible_recipients \
+            if not family_name.search(name)
+    ]
+
+    # sample() returns a LIST, so just return the first elem
+    if len(non_family_members) > 0:
+        return sample(non_family_members, 1)[0]
+    else:
+        return sample(recipients, 1)[0]
+
+def secretSanta(names):
+    # let's use a dictionary to hold the giver/recipient
+    # pairings
+    results = {}
+ 
+    # copy the names into a new list
+    available_recipients = names.copy()
+
+    # now go through each of the names and find a
+    # recipient for them
+    must_redo = False
+    for giver in names:
+        recipient = findRecipient(giver, available_recipients)
+        if recipient is None:
+            must_redo = True
+        results[giver] = recipient
+        available_recipients.remove(recipient)
+
+    if must_redo:
+        return secretSanta(names)
+    else:
+        return results
+
+def comma_join(arr):
+    return "',\n                 '".join(arr)
+
+def solution(names):
+    print(f"Input: @names = ('{comma_join(names)}')")
+    recipients = secretSanta(names)
+    print(f'Output:')
+    for giver in names:
+        print(f"    {giver} -> {recipients[giver]}")
+
+print('Example 1:')
+solution(['Mr. Wall', 'Mrs. Wall', 'Mr. Anwar',
+          'Mrs. Anwar', 'Mr. Conway', 'Mr. Cross'])
+
+print('\nExample 2:')
+solution(['Mr. Wall', 'Mrs. Wall', 'Mr. Anwar'])
diff --git a/challenge-247/packy-anderson/python/ch-2.py b/challenge-247/packy-anderson/python/ch-2.py
new file mode 100755
index 0000000000..88449cfec3
--- /dev/null
+++ b/challenge-247/packy-anderson/python/ch-2.py
@@ -0,0 +1,90 @@
+#!/usr/bin/env python
+
+# https://docs.python.org/3/library/collections.html#counter-objects
+from collections import Counter
+
+from num2words import num2words
+
+def conjunction(words):
+    if len(words) < 2:
+        return(words)
+    elif len(words) == 2:
+        return(f'{words[0]} and {words[1]}')
+    else:
+        last = words.pop(-1)
+        l = ', '.join(words)
+        return(f'{l}, and {last}')
+
+def pairCount(s):
+    # instantiate a counter object
+    count = Counter()
+    while (len(s) > 1):
+        pair = s[0:2]    # the first two characters
+        count[pair] += 1 # count the pair
+        s = s[1:]        # remove the first character
+    # convert it back to a dict now that we're done counting
+    return dict(count)
+
+def mostFrequentPair(s):
+    # count the letter pairs
+    pairs = pairCount(s)
+
+    # sort the pairs by their counts
+    # use the Decorate-Sort-Undecorate idiom
+    # to convert the dict into a list
+    # https://docs.python.org/3/howto/sorting.html#decorate-sort-undecorate
+    decorated = [ (pairs[p], p) for p in pairs.keys() ]
+    sorted_tuples = sorted(
+        decorated,
+        # the - before the first element sorts descending
+        key=lambda k: (-k[0], k[1])
+    )
+    sorted_pairs = [ t[1] for t in sorted_tuples ]
+
+    max_pair = []
+    # pull off first value from the sorted pairs
+    max_pair.append( sorted_pairs.pop(0) )
+    # get it's count
+    max_count = pairs[ max_pair[0] ]
+
+    while pairs[ sorted_pairs[0] ] == max_count:
+        # there are pairs on the sorted list that have the
+        # same count, so let's put them on the list, too
+        max_pair.append( sorted_pairs.pop(0) )
+
+    # set aside the pair that sorted to the top
+    first_pair = max_pair[0]
+
+    # make the count an english word
+    count = (
+        'once'  if (max_count == 1) else # 🎶
+        'twice' if (max_count == 2) else # 🎶
+        num2words(max_count) + ' times'  # a lady 🎶
+    )
+
+    # and format the explanation
+    if len(max_pair) == 1:
+        explain = f"'{first_pair}' appears {count} in \$s"
+    else:
+        # quote all the pairs
+        max_pair = [ f"'{x}'" for x in max_pair]
+        explain = f"{conjunction(max_pair)} appear {count} in "
+        explain += f"$s and '{first_pair}' is "
+        explain += "lexicographically smallest."
+
+    return first_pair, explain
+
+def solution(s):
+    print(f"Input: @s = '{s}'")
+    (pair, explain) = mostFrequentPair(s)
+    print(f"Output: '{pair}'\n")
+    print(explain)
+
+print('Example 1:')
+solution('abcdbca')
+
+print('\nExample 2:')
+solution('cdeabeabfcdfabgcd')
+
+print('\nExample 3:')
+solution('abcdeabcde')
\ No newline at end of file
diff --git a/challenge-247/packy-anderson/raku/ch-1.raku b/challenge-247/packy-anderson/raku/ch-1.raku
new file mode 100755
index 0000000000..275192b8fc
--- /dev/null
+++ b/challenge-247/packy-anderson/raku/ch-1.raku
@@ -0,0 +1,71 @@
+#!/usr/bin/env raku
+use v6;
+
+sub findRecipient($giver, %recipients) {
+  # since %recipients is passed by reference, we can't
+  # modify it, so let's make a copy with the giver removed
+  my @recipients = %recipients.keys.grep({ !/$giver/ });
+
+  # split on whitespace and take the last element
+  # to get the "family name"
+  my $family_name = split(" ", $giver)[*-1];
+
+  # now, make a potential recipient hash
+  # excluding family members
+  my @non_family_members =
+    @recipients.grep({ !/$family_name/ });
+
+  if (@non_family_members > 0) {
+    return @non_family_members.pick;
+  }
+  else {
+    return @recipients.pick;
+  }
+}
+
+sub secretSanta(@names) {
+  # let's use a hash to hold the giver/recipient pairings
+  my %results;
+ 
+  # put our work in a labelled loop
+  ASSIGN_RECIPIENTS: loop {
+    # convert the array of names into a hash with names as keys
+    my %available_recipients = @names.map: * => 1;
+
+    # now go through each of the names and find a
+    # recipient for them
+    for @names -> $giver {
+      my $recipient =
+        findRecipient($giver, %available_recipients);
+
+      # occasionally, we assign recipients so in the last
+      # iteration of the for loop the only available
+      # recipient is $giver. When that happens, the easiest
+      # way to fix things is to just re-do the entire list
+      redo ASSIGN_RECIPIENTS if ! defined $recipient;
+
+      %results{$giver} = $recipient;
+      %available_recipients{$recipient}:delete;
+    }
+    last; # exit the labelled loop
+  }
+  return %results;
+}
+
+sub solution(@names) {
+  say "Input: \@names = ('"
+    ~ @names.join("',\n                 '")
+    ~ "')";
+  my %recipients = secretSanta(@names);
+  say "Output:";
+  for @names -> $giver {
+    say "    $giver -> %recipients{$giver}";
+  }
+}
+
+say "Example 1:";
+solution(['Mr. Wall', 'Mrs. Wall', 'Mr. Anwar',
+          'Mrs. Anwar', 'Mr. Conway', 'Mr. Cross']);
+
+say "\nExample 2:";
+solution(['Mr. Wall', 'Mrs. Wall', 'Mr. Anwar']);
diff --git a/challenge-247/packy-anderson/raku/ch-2.raku b/challenge-247/packy-anderson/raku/ch-2.raku
new file mode 100755
index 0000000000..601867724c
--- /dev/null
+++ b/challenge-247/packy-anderson/raku/ch-2.raku
@@ -0,0 +1,80 @@
+#!/usr/bin/env raku
+use v6;
+
+use Lingua::Conjunction;
+use Lingua::EN::Numbers;
+
+sub pairCount($string) {
+  my $s = $string; # make a copy so we can modify it
+  my %count;
+  while ($s.chars > 1) {
+    my $pair = substr($s, 0..1); # the first two characters
+    %count{$pair}++;          # count the pair
+    $s = substr($s, 1, *); # remove the first character
+  }
+  return %count;
+}
+
+sub mostFrequentPair($s) {
+  # count the letter pairs
+  my %pairs = pairCount($s);
+
+  # sort the pairs by their counts
+  my @sorted = %pairs.keys.sort: {
+    # sort by count first
+    %pairs{$^b} <=> %pairs{$^a}
+    ||
+    # then by lexicographical order
+    $^a cmp $^b
+  };
+
+  my @max_pair  = shift(@sorted); # pull off first value
+  my $max_count = %pairs{@max_pair[0]}; # get it's count
+
+  while ( %pairs{@sorted[0]} == $max_count ) {
+    # there are pairs on the sorted list that have the
+    # same count, so let's put them on the list, too
+    @max_pair.append( shift(@sorted) );
+  }
+  my $explain;
+
+  # set aside the pair that sorted to the top
+  my $first_pair = @max_pair[0];
+
+  # now quote all the pairs
+  @max_pair = @max_pair.map: { qq{'$_'} };
+
+  # make the count an english word
+  my $count =  ($max_count == 1) ?? 'once'      # 🎶
+            !! ($max_count == 2) ?? 'twice'     # 🎶
+            !! cardinal($max_count) ~ ' times'; # a lady 🎶
+
+  # and format the explanation
+  if (@max_pair == 1) {
+    $explain = "'$first_pair' appears $count in \$s";
+  }
+  else {
+    my $str = qq{|list| appear $count in \$s and }
+            ~ qq{'$first_pair' is lexicographically smallest.};
+    $explain = conjunction @max_pair, :$str;
+  }
+
+  return $first_pair, $explain;
+}
+
+sub solution($s) {
+  say "Input: \$s = '$s'";
+  my ($pair, $explain) = mostFrequentPair($s);
+  say "Output: '$pair'";
+  say "";
+  say $explain;
+}
+
+say "Example 1:";
+solution('abcdbca');
+
+say "\nExample 2:";
+solution('cdeabeabfcdfabgcd');
+
+say "\nExample 3:";
+solution('abcdeabcde');