From 76dd57bbc153db7d4c51fb228bcdb2127486dd34 Mon Sep 17 00:00:00 2001 From: Peter Campbell Smith Date: Mon, 21 Jul 2025 16:01:57 +0100 Subject: Week 331 - Last word, buddy --- challenge-331/peter-campbell-smith/blog.txt | 1 + challenge-331/peter-campbell-smith/perl/ch-1.pl | 23 ++++++++ challenge-331/peter-campbell-smith/perl/ch-2.pl | 72 +++++++++++++++++++++++++ 3 files changed, 96 insertions(+) create mode 100644 challenge-331/peter-campbell-smith/blog.txt create mode 100755 challenge-331/peter-campbell-smith/perl/ch-1.pl create mode 100755 challenge-331/peter-campbell-smith/perl/ch-2.pl diff --git a/challenge-331/peter-campbell-smith/blog.txt b/challenge-331/peter-campbell-smith/blog.txt new file mode 100644 index 0000000000..9a9445b05c --- /dev/null +++ b/challenge-331/peter-campbell-smith/blog.txt @@ -0,0 +1 @@ +http://ccgi.campbellsmiths.force9.co.uk/challenge/331 diff --git a/challenge-331/peter-campbell-smith/perl/ch-1.pl b/challenge-331/peter-campbell-smith/perl/ch-1.pl new file mode 100755 index 0000000000..80148ac071 --- /dev/null +++ b/challenge-331/peter-campbell-smith/perl/ch-1.pl @@ -0,0 +1,23 @@ +#!/usr/bin/perl + +# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +use v5.26; # The Weekly Challenge - 2025-07-21 +use utf8; # Week 331 - task 1 - Last word +use warnings; # Peter Campbell Smith +binmode STDOUT, ':utf8'; +use Encode; + +last_word('The Weekly Challenge'); +last_word(' Hello World '); +last_word('123 4567'); +last_word(''); +last_word('Danger!'); + +sub last_word { + + $_[0] =~ m|([a-z]+)[^a-z]*$|i; + + say qq[\nInput: '$_[0]']; + say qq[Output: ] . (defined($1) ? length($1) : 0); +} diff --git a/challenge-331/peter-campbell-smith/perl/ch-2.pl b/challenge-331/peter-campbell-smith/perl/ch-2.pl new file mode 100755 index 0000000000..55ea8fac35 --- /dev/null +++ b/challenge-331/peter-campbell-smith/perl/ch-2.pl @@ -0,0 +1,72 @@ +#!/usr/bin/perl + +# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +use v5.26; # The Weekly Challenge - 2025-07-21 +use utf8; # Week 331 - task 2 - Buddy strings +use warnings; # Peter Campbell Smith +binmode STDOUT, ':utf8'; +use Encode; + +buddy_strings('luck', 'lcuk'); +buddy_strings('love', 'love'); +buddy_strings('feed', 'feed'); +buddy_strings('enchilada', 'anchilade'); +buddy_strings('3 blind mice', '3 clind mibe'); +buddy_strings('12345', '12435'); + +sub buddy_strings { + + my ($one, $two, $length, $result, $j, $char1, $char2, $mismatch, %seen); + + # initialise + ($one, $two) = @_; + + # loop over corresponding chars in each string + $length = length($one); + $result = 'false'; + if ($length == length($two)) { + for $j (0 .. $length - 1) { + $char1 = substr($one, $j, 1); + $char2 = substr($two, $j, 1); + + # swapped chars must be letters + next unless ($char1 . $char2) =~ m|[a-z]{2}|i; + + # if they differ + if ($char1 ne $char2) { + + # this is the first mismatch, so save it + unless (defined $mismatch) { + $mismatch = $j; + + # this is the second mismatch, so can it swap with the first? + } elsif ($result eq 'false') { + if ($char1 eq substr($two, $mismatch, 1) and $char2 eq substr($one, $mismatch, 1)) { + $result = qq[true - '$char1' and '$char2']; + } + + # this is a 3rd mismatch so not buddies + } else { + $result = 'false'; + last; + } + } + } + + # check for identical strings with (any) repeated letter + if ($one eq $two) { + for $j (0 .. $length - 1) { + $char1 = substr($one, $j, 1); + if ($seen{$char1}) { + $result = qq[true - '$char1' and '$char1']; + last; + } + $seen{$char1} = 1 if $char1 =~ m|[a-z]|; + } + } + } + + say qq[\nInput: \$source = '$one', \$target = '$two']; + say qq[Output: $result]; +} -- cgit