Merge pull request #9266 from jacoby/master

solved 247

3 files changed, 95 insertions, 0 deletions

diff --git a/challenge-247/dave-jacoby/blog.txt b/challenge-247/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..6bd07983bc
--- /dev/null
+++ b/challenge-247/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2023/12/11/partidges-and-pair-trees-weekly-challenge-247.html
diff --git a/challenge-247/dave-jacoby/perl/ch-1.pl b/challenge-247/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..d96619aa19
--- /dev/null
+++ b/challenge-247/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = (
+
+    [
+        'Mr. Wall',
+        'Mrs. Wall',
+        'Mr. Anwar',
+        'Mrs. Anwar',
+        'Mr. Conway',
+        'Mr. Cross',
+    ],
+
+    [ 'Mr. Wall', 'Mrs. Wall', 'Mr. Anwar', ],
+);
+
+for my $example (@examples) {
+    my %output = secret_santa( $example->@* );
+    my $input = join ",\n\t",
+        map  { qq{"$_"} }                               # quote surname
+        map  { $_->[0] }                                # remove surname element
+        sort { $a->[1] cmp $b->[1] }                    # sort on surname
+        map  { [ $_, ( reverse split /\s/, $_ )[0] ] }  # start schartzian transform on surname
+        sort { $a cmp $b } $example->@*;                # sort alphabetically for consistency
+    my $output = join "\n\t",
+        map  { qq{$_ -> $output{$_}} }                  # combine santa and giftee 
+        map  { $_->[0] }                                # remove surname element
+        sort { $a->[1] cmp $b->[1] }                    # sort on surname
+        map  { [ $_, ( reverse split /\s/, $_ )[0] ] }  # start schartzian transform on surname
+        sort { $a cmp $b } keys %output;                # sort alphabetically for consistency
+
+    say <<~"END";
+    Input:  \$input = (
+            $input
+            );
+    Output:
+            $output
+    END
+
+}
+
+# 1) everybody gets matched
+# 2) nobody gets matched to themself
+sub secret_santa (@input) {
+    my %done;
+
+    for my $name (@input) {
+        my %chosen = reverse %done;
+        my @others =
+            sort { rand 10 <=> rand 10 }
+            grep { $_ ne $name } @input;
+        for my $giftee (@others) {
+            next if $chosen{$giftee};
+            $done{$name} = $giftee;
+        }
+    }
+    return %done;
+}
diff --git a/challenge-247/dave-jacoby/perl/ch-2.pl b/challenge-247/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..cdc7dabc15
--- /dev/null
+++ b/challenge-247/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = (
+
+    'abcdbca',
+    'cdeabeabfcdfabgcd',
+);
+
+for my $e (@examples) {
+    my $output = most_frequent_letter_pair($e);
+
+    say <<~"END";
+    Input:  \$input = '$e'
+    Output:          '$output'
+    END
+}
+
+sub most_frequent_letter_pair ($string) {
+    my %data;
+    for my $i ( 0 .. -2 + length $string ) {
+        my $sub = substr $string, $i, 2;
+        $data{$sub}++;
+    }
+    # ($scalar) = @list will assign the first element in the list to $scalar
+    my ($first) = sort { $data{$b} <=> $data{$a} }  # second sort on value
+        sort keys %data;                            # first sort on lexographic value
+    return $first;
+}