diff options
| -rw-r--r-- | challenge-317/bob-lied/README.md | 6 | ||||
| -rw-r--r-- | challenge-317/bob-lied/perl/ch-1.pl | 58 | ||||
| -rw-r--r-- | challenge-317/bob-lied/perl/ch-2.pl | 84 |
3 files changed, 145 insertions, 3 deletions
diff --git a/challenge-317/bob-lied/README.md b/challenge-317/bob-lied/README.md index 54cbf65f11..6f5780a79d 100644 --- a/challenge-317/bob-lied/README.md +++ b/challenge-317/bob-lied/README.md @@ -1,4 +1,4 @@ -# Solutions to weekly challenge 316 by Bob Lied +# Solutions to weekly challenge 317 by Bob Lied -## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-316/) -## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-316/bob-lied) +## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-317/) +## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-317/bob-lied) diff --git a/challenge-317/bob-lied/perl/ch-1.pl b/challenge-317/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..8a7333374d --- /dev/null +++ b/challenge-317/bob-lied/perl/ch-1.pl @@ -0,0 +1,58 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2025, Bob Lied +#============================================================================= +# ch-1.pl Perl Weekly Challenge 317 Task 1 Acronyms +#============================================================================= +# You are given an array of words and a word. Write a script to return +# true if concatenating the first letter of each word in the given array +# matches the given word, return false otherwise. +# Example 1 Input: @array = ("Perl", "Weekly", "Challenge") $word = "PWC" +# Output: true +# Example 2 Input: @array = ("Bob", "Charlie", "Joe") $word = "BCJ" +# Output: true +# Example 3 Input: @array = ("Morning", "Good") $word = "MM" +# Output: false +#============================================================================= + +use v5.40; + + +use Getopt::Long; +my $Verbose = false; +my $DoTest = false; +my $Benchmark = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark); +my $logger; +{ + use Log::Log4perl qw(:easy); + Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ), + layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" }); + $logger = Log::Log4perl->get_logger(); +} +#============================================================================= + +exit(!runTest()) if $DoTest; +exit( runBenchmark($Benchmark) ) if $Benchmark; + +my $WORD = pop @ARGV; +say isAcro([@ARGV], $WORD) ? "true" : "false"; + +#============================================================================= +sub isAcro($array, $word) +{ + return $word eq join("", map { substr($_, 0, 1) } $array->@*); +} + +sub runTest +{ + use Test2::V0; + + is( isAcro([qw/Perl Weekly Challenge/], "PWC"), true, "Example 1"); + is( isAcro([qw/Bob Charlie Joe/], "BCJ"), true, "Example 2"); + is( isAcro([qw/Morning Good/], "MM"), false, "Example 3"); + + done_testing; +} diff --git a/challenge-317/bob-lied/perl/ch-2.pl b/challenge-317/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..cc96a89797 --- /dev/null +++ b/challenge-317/bob-lied/perl/ch-2.pl @@ -0,0 +1,84 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2025, Bob Lied +#============================================================================= +# ch-2.pl Perl Weekly Challenge 317 Task 2 Friendly Strings +#============================================================================= +# You are given two strings. Write a script to return true if swapping +# any two letters in one string match the other string, return false otherwise. +# Example 1 Input: $str1 = "desc", $str2 = "dsec" +# Output: true +# Example 2 Input: $str1 = "fuck", $str2 = "fcuk" +# Output: true +# Example 3 Input: $str1 = "poo", $str2 = "eop" +# Output: false +# Example 4 Input: $str1 = "stripe", $str2 = "sprite" +# Output: true +#============================================================================= + +use v5.40; + +use Getopt::Long; +my $Verbose = false; +my $DoTest = false; +my $Benchmark = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark); +my $logger; +{ + use Log::Log4perl qw(:easy); + Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ), + layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" }); + $logger = Log::Log4perl->get_logger(); +} +#============================================================================= + +exit(!runTest()) if $DoTest; +exit( runBenchmark($Benchmark) ) if $Benchmark; + +say isFriend(@ARGV) ? "true" : "false"; + +#============================================================================= +sub isFriend($str1, $str2) +{ + if ( length($str1) != length($str2) ) + { + return false; + } + elsif ( $str1 eq $str2 ) + { + # There must be a repeated letter that can be swapped for itself + use List::MoreUtils qw/duplicates/; + return duplicates(split(//, $str1)) > 0; + } + else + { + # Make pairs of characters and check for differences. + use List::Util qw/zip/; + my @diff = grep { $_->[0] ne $_->[1] } + zip( [split(//, $str1)], [split(//, $str2)] ); + + # There must be exactly two differences that can be swapped. + return @diff == 2 + && $diff[0][0] eq $diff[1][1] && $diff[0][1] eq $diff[1][0]; + } +} + +sub runTest +{ + use Test2::V0; + + is( isFriend("desc", "dsec" ), true, "Example 1"); + is( isFriend("fuck", "fcuk" ), true, "Example 2"); + is( isFriend("poo", "eop" ), false, "Example 3"); + is( isFriend("stripe", "sprite"), true, "Example 4"); + + is( isFriend("abcd", "abXd" ), false, "Different, but not swapped"); + is( isFriend("abcd", "baXd" ), false, "Different after one swap"); + is( isFriend("abcd", "badc" ), false, "More than one swap"); + is( isFriend("AAAA", "AAAA" ), true, "Same with repeated letter"); + is( isFriend("WXYZ", "WXYZ" ), false, "Same with no repeat"); + + done_testing; +} |