diff options
| -rw-r--r-- | challenge-275/bob-lied/README | 6 | ||||
| -rw-r--r-- | challenge-275/bob-lied/perl/ch-1.pl | 81 | ||||
| -rw-r--r-- | challenge-275/bob-lied/perl/ch-2.pl | 62 |
3 files changed, 146 insertions, 3 deletions
diff --git a/challenge-275/bob-lied/README b/challenge-275/bob-lied/README index f308a5c62c..c6ba3198ae 100644 --- a/challenge-275/bob-lied/README +++ b/challenge-275/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 274 by Bob Lied +Solutions to weekly challenge 275 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-274/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-274/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-275/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-275/bob-lied diff --git a/challenge-275/bob-lied/perl/ch-1.pl b/challenge-275/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..fef05b2694 --- /dev/null +++ b/challenge-275/bob-lied/perl/ch-1.pl @@ -0,0 +1,81 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2024, Bob Lied +#============================================================================= +# ch-1.pl Perl Weekly Challenge 275 Task 1 Broken Keys +#============================================================================= +# You are given a sentence, $sentence and list of broken keys @keys. +# Write a script to find out how many words can be typed fully. +# Example 1 Input: $sentence = "Perl Weekly Challenge", @keys = ('l', 'a') +# Output: 0 +# Every word requires one of the broken keys. +# Example 2 Input: $sentence = "Perl and Raku", @keys = ('a') +# Output: 1 +# Only Perl since the other word two words contain 'a' and can't be typed. +# Example 3 Input: $sentence = "Well done Team PWC", @keys = ('l', 'o') +# Output: 2 +# Example 4 Input: $sentence = "The joys of polyglottism", @keys = ('T') +# Output: 2 +#============================================================================= + +use v5.40; + +use Getopt::Long; +my $DoTest = false; +my $Benchmark = 0; + +GetOptions("test" => \$DoTest, "benchmark:i" => \$Benchmark); +exit(!runTest()) if $DoTest; +exit( runBenchmark($Benchmark) ) if $Benchmark; + +say brokenKeys(@ARGV); + +sub brokenKeys($sentence, @keys) +{ + my @s = split(/\W+/, $sentence); + for my $broken ( @keys ) + { + @s = grep !/$broken/i, @s; + } + return scalar(@s); +} + +sub bk($sentence, @keys) +{ + # my $re = '^[^' . join("", @keys) . ']*$'; + # return scalar grep /$re/i, split(/\W+/, $sentence); + # my $re = '[' . join("", @keys) . ']'; + my $re; + { local $, = ''; $re = qq([@keys]); } + my @s = split(/\W+/, $sentence); + return scalar(@s) - ( grep /$re/i, @s ); +} + +sub runTest +{ + use Test2::V0; + + is( brokenKeys("Perl Weekly Challenge", 'l', 'a'), 0, "Example 1"); + is( brokenKeys("Perl and Raku", 'a' ), 1, "Example 2"); + is( brokenKeys("Well done Team PWC", 'l', 'o'), 2, "Example 3"); + is( brokenKeys("The joys of polyglottism", 'T' ), 2, "Example 4"); + + is( bk("Perl Weekly Challenge", 'l', 'a'), 0, "Example 1 bk"); + is( bk("Perl and Raku", 'a' ), 1, "Example 2 bk"); + is( bk("Well done Team PWC", 'l', 'o'), 2, "Example 3 bk"); + is( bk("The joys of polyglottism", 'T' ), 2, "Example 4 bk"); + + done_testing; +} + +sub runBenchmark($repeat) +{ + use Benchmark qw/cmpthese/; + my $sentence = "It's eighty degrees and I'm down on my knees in Brooklyn"; + + cmpthese($repeat, { + re => sub { bk($sentence, qw(f a w z y) ) }, + loop => sub { brokenKeys($sentence, qw(f a w z y) ) }, + }); +} diff --git a/challenge-275/bob-lied/perl/ch-2.pl b/challenge-275/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..97019a077f --- /dev/null +++ b/challenge-275/bob-lied/perl/ch-2.pl @@ -0,0 +1,62 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2024, Bob Lied +#============================================================================= +# ch-2.pl Perl Weekly Challenge 275 Task 2 Replace Digits +#============================================================================= +# You are given an alphanumeric string, $str, where each character is +# either a letter or a digit. +# Write a script to replace each digit in the given string with the +# value of the previous letter plus (digit) places. +# Example 1 Input: $str = 'a1c1e1' +# Ouput: 'abcdef' +# shift('a', 1) => 'b' shift('c', 1) => 'd' shift('e', 1) => 'f' +# Example 2 Input: $str = 'a1b2c3d4' +# Output: 'abbdcfdh' +# shift('a', 1) => 'b' shift('b', 2) => 'd' +# shift('c', 3) => 'f' shift('d', 4) => 'h' +# Example 3 Input: $str = 'b2b' +# Output: 'bdb' +# Example 4 Input: $str = 'a16z' +# Output: 'abgz' +#============================================================================= + +use v5.40; + + +use Getopt::Long; +my $DoTest = false; +my $Benchmark = 0; + +GetOptions("test" => \$DoTest); +exit(!runTest()) if $DoTest; + +# Must not begin with a digit +say replaceDigits($_) for map { s/^[0-9]*//ir } @ARGV; + +sub replaceDigits($str) +{ + my @s = split("", $str); + my $letter = my $result = shift @s; + + while ( defined(my $next = shift @s) ) + { + if ( $next =~ m/[^0-9]/i ) { $result .= ($letter = $next) } + else { $result .= chr(ord($letter) + $next); } + } + return $result; +} + + +sub runTest +{ + use Test2::V0; + + is( replaceDigits("a1c1e1" ), "abcdef" , "Example 1"); + is( replaceDigits("a1b2c3d4"), "abbdcfdh", "Example 2"); + is( replaceDigits("b2b" ), "bdb" , "Example 3"); + is( replaceDigits("a16z" ), "abgz" , "Example 4"); + + done_testing; +} |