diff options
| -rw-r--r-- | challenge-247/wlmb/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-247/wlmb/perl/ch-1.pl | 26 | ||||
| -rwxr-xr-x | challenge-247/wlmb/perl/ch-2.pl | 19 |
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]" +} |