From 4506b713da2b9a42d1364c2af1ffe62180c7f0b3 Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Sat, 29 Jun 2024 06:55:27 -0500 Subject: Week 275 solutions --- challenge-275/bob-lied/README | 6 +-- challenge-275/bob-lied/perl/ch-1.pl | 81 +++++++++++++++++++++++++++++++++++++ challenge-275/bob-lied/perl/ch-2.pl | 72 +++++++++++++++++++++++++++++++++ 3 files changed, 156 insertions(+), 3 deletions(-) create mode 100644 challenge-275/bob-lied/perl/ch-1.pl create mode 100644 challenge-275/bob-lied/perl/ch-2.pl 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..4e996497cb --- /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) . ']'; + local $, = ''; + my $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..4c9897fe9e --- /dev/null +++ b/challenge-275/bob-lied/perl/ch-2.pl @@ -0,0 +1,72 @@ +#!/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, "benchmark:i" => \$Benchmark); +exit(!runTest()) if $DoTest; +exit( runBenchmark($Benchmark) ) if $Benchmark; + +# Must begin not begin with a digit +say replaceDigits($_) for map { s/^[0-9]*//ir } @ARGV; + +sub replaceDigits($str) +{ + my @s = split("", $str); + my $prev = my $result = shift @s; + + while ( defined(my $next = shift @s) ) + { + if ( $next =~ m/[^0-9]/i ) { $result .= ($prev = $next) } + else { $result .= chr(ord($prev) + $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; +} + +sub runBenchmark($repeat) +{ + use Benchmark qw/cmpthese/; + + cmpthese($repeat, { + label => sub { }, + }); +} -- cgit From 676bf0a16c662661d9ccb702910f18118aac8aa8 Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Sat, 29 Jun 2024 07:02:43 -0500 Subject: Week 275 code review/proofread --- challenge-275/bob-lied/perl/ch-1.pl | 4 ++-- challenge-275/bob-lied/perl/ch-2.pl | 20 +++++--------------- 2 files changed, 7 insertions(+), 17 deletions(-) diff --git a/challenge-275/bob-lied/perl/ch-1.pl b/challenge-275/bob-lied/perl/ch-1.pl index 4e996497cb..fef05b2694 100644 --- a/challenge-275/bob-lied/perl/ch-1.pl +++ b/challenge-275/bob-lied/perl/ch-1.pl @@ -46,8 +46,8 @@ sub bk($sentence, @keys) # my $re = '^[^' . join("", @keys) . ']*$'; # return scalar grep /$re/i, split(/\W+/, $sentence); # my $re = '[' . join("", @keys) . ']'; - local $, = ''; - my $re = qq([@keys]); + my $re; + { local $, = ''; $re = qq([@keys]); } my @s = split(/\W+/, $sentence); return scalar(@s) - ( grep /$re/i, @s ); } diff --git a/challenge-275/bob-lied/perl/ch-2.pl b/challenge-275/bob-lied/perl/ch-2.pl index 4c9897fe9e..97019a077f 100644 --- a/challenge-275/bob-lied/perl/ch-2.pl +++ b/challenge-275/bob-lied/perl/ch-2.pl @@ -29,22 +29,21 @@ use Getopt::Long; my $DoTest = false; my $Benchmark = 0; -GetOptions("test" => \$DoTest, "benchmark:i" => \$Benchmark); +GetOptions("test" => \$DoTest); exit(!runTest()) if $DoTest; -exit( runBenchmark($Benchmark) ) if $Benchmark; -# Must begin not begin with a digit +# Must not begin with a digit say replaceDigits($_) for map { s/^[0-9]*//ir } @ARGV; sub replaceDigits($str) { my @s = split("", $str); - my $prev = my $result = shift @s; + my $letter = my $result = shift @s; while ( defined(my $next = shift @s) ) { - if ( $next =~ m/[^0-9]/i ) { $result .= ($prev = $next) } - else { $result .= chr(ord($prev) + $next); } + if ( $next =~ m/[^0-9]/i ) { $result .= ($letter = $next) } + else { $result .= chr(ord($letter) + $next); } } return $result; } @@ -61,12 +60,3 @@ sub runTest done_testing; } - -sub runBenchmark($repeat) -{ - use Benchmark qw/cmpthese/; - - cmpthese($repeat, { - label => sub { }, - }); -} -- cgit