Merge pull request #9231 from wlmb/challenges

Solve PWC247

3 files changed, 46 insertions, 0 deletions

diff --git a/challenge-247/wlmb/blog.txt b/challenge-247/wlmb/blog.txt
new file mode 100644
index 0000000000..fb01e3096f
--- /dev/null
+++ b/challenge-247/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2023/12/11/PWC247/
diff --git a/challenge-247/wlmb/perl/ch-1.pl b/challenge-247/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..5f20b58274
--- /dev/null
+++ b/challenge-247/wlmb/perl/ch-1.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 247
+# Task 1:  Secret Santa
+#
+# See https://wlmb.github.io/2023/12/11/PWC247/#task-1-secret-santa
+use v5.36;
+use experimental qw(postderef);
+my %last_name;
+my %person;
+# Input from STDIN, one name per line
+while(<>){
+    chomp;
+    my (undef,$last)=split " ";
+    $last_name{$_}=$last;
+    push $person{$last}->@*, $_;
+}
+my @families=sort {$person{$b}->@*<=>$person{$a}->@*} keys %person;
+my $first_giver;
+while(@families){
+    my $family_giver=shift @families;
+    my $giver=shift $person{$family_giver}->@*;
+    $first_giver//=$giver;
+    push @families, $family_giver if $person{$family_giver}->@*;
+    my $receiver=$families[0]?$person{$families[0]}[0]:$first_giver;
+    say "$giver -> $receiver";
+}
diff --git a/challenge-247/wlmb/perl/ch-2.pl b/challenge-247/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..1bb4c00ce0
--- /dev/null
+++ b/challenge-247/wlmb/perl/ch-2.pl
@@ -0,0 +1,19 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 247
+# Task 2:  Most Frequent Letter Pair
+#
+# See https://wlmb.github.io/2023/12/11/PWC247/#task-2-most-frequent-letter-pair
+use v5.36;
+die <<~"FIN" unless @ARGV;
+    Usage: $0 S1 [S2...]
+    to find the most frequent pair of consecutive letters
+    from each of the strings S1, S2...
+    FIN
+for(@ARGV){
+    my @letters=split "";
+    my $first=shift @letters;
+    my %count;
+    $count{$_}++ for map{my $previous=$first; $first=$_; "$previous$first"}@letters;
+    my @sorted =sort{$count{$b}<=>$count{$a}||$a cmp $b} keys %count;
+    say "$_ -> $sorted[0]"
+}