diff options
106 files changed, 7276 insertions, 3084 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; +} diff --git a/challenge-248/bob-lied/README b/challenge-248/bob-lied/README index ddf6e99243..882a98a265 100644 --- a/challenge-248/bob-lied/README +++ b/challenge-248/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 247 by Bob Lied +Solutions to weekly challenge 248 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-247/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-247/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-248/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-248/bob-lied diff --git a/challenge-248/bob-lied/perl/ch-1.pl b/challenge-248/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..e202a54191 --- /dev/null +++ b/challenge-248/bob-lied/perl/ch-1.pl @@ -0,0 +1,141 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# ch-1.pl Perl Weekly Challenge 248 Task 1 Shortest Distance +#============================================================================= +# You are given a string and a character in the given string. +# Write a script to return an array of integers of size same as length of +# the given string such that: +# distance[i] is the distance from index i to the closest occurence of +# the given character in the given string. +# The distance between two indices i and j is abs(i - j). +# Example 1 Input: $str = "loveleetcode", $char = "e" +# Output: (3,2,1,0,1,0,0,1,2,2,1,0) +# The character 'e' appears at indices 3, 5, 6, and 11 (0-indexed). +# The closest occurrence of 'e' for index 0 is at index 3, +# so the distance is abs(0 - 3) = 3. +# The closest occurrence of 'e' for index 1 is at index 3, +# so the distance is abs(1 - 3) = 2. +# For index 4, there is a tie between the 'e' at index 3 and 'e' at index 5, +# but the distance is still the same: abs(4 - 3) == abs(4 - 5) = 1. +# The closest occurrence of 'e' for index 8 is at index 6, +# so the distance is abs(8 - 6) = 2. +# Example 2 Input: $str = "aaab", $char = "b" +# Output: (3,2,1,0) +#============================================================================= + +use v5.38; + +use builtin qw/true false ceil floor/; no warnings "experimental::builtin"; + +use List::Util qw/min/; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +say "(", join(",", shortest(@ARGV)->@*), ")"; + +sub shortest($str, $char) +{ + my @dist; + my @s = split //, $str; # str as vector of characters + + # List of indexes where char appears + my @cloc = grep { $s[$_] eq $char } 0 .. $#s; + + # Potentially a lot of useless array operations, math + # and comparisons if char appears a lot. + for my $i ( 0 .. $#s ) # For each letter in str + { + # List of location differences + # vvvvvvvvvvvvvvvvvvvvvvvvvvvv + push @dist, min map { abs($_ - $i) } @cloc; + } + return \@dist; +} + +# Only two location differences really matter: the next one +# ahead or the last one behind. Alternate implementation +# looks only for those two. Potentially a lot of string +# scanning if there are very few occurences of char in a +# long string. +sub sd2($str, $char) +{ + my |