diff options
| -rw-r--r-- | challenge-318/bob-lied/README.md | 6 | ||||
| -rw-r--r-- | challenge-318/bob-lied/perl/ch-1.pl | 59 | ||||
| -rw-r--r-- | challenge-318/bob-lied/perl/ch-2.pl | 81 |
3 files changed, 143 insertions, 3 deletions
diff --git a/challenge-318/bob-lied/README.md b/challenge-318/bob-lied/README.md index 6f5780a79d..4fc0332efa 100644 --- a/challenge-318/bob-lied/README.md +++ b/challenge-318/bob-lied/README.md @@ -1,4 +1,4 @@ -# Solutions to weekly challenge 317 by Bob Lied +# Solutions to weekly challenge 318 by Bob Lied -## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-317/) -## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-317/bob-lied) +## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-318/) +## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-318/bob-lied) diff --git a/challenge-318/bob-lied/perl/ch-1.pl b/challenge-318/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..414321bec5 --- /dev/null +++ b/challenge-318/bob-lied/perl/ch-1.pl @@ -0,0 +1,59 @@ +#!/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 318 Task 1 Group Position +#============================================================================= +# You are given a string of lowercase letters. Write a script to find the +# position of all groups in the given string. Three or more consecutive +# letters form a group. Return "” if none found. +# Example 1 Input: $str = "abccccd" +# Output: "cccc" +# Example 2 Input: $str = "aaabcddddeefff" +# Output: "aaa", "dddd", "fff" +# Example 3 Input: $str = "abcdd" +# Output: "" +#============================================================================= + +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 '"', join('", "', groupPosition($_)->@*), '"' for @ARGV; + +#============================================================================= +sub groupPosition($str) +{ + my @group; + push @group, $1 while ( $str =~ m/((.)\2{2,})/g ); + return \@group; +} + +sub runTest +{ + use Test2::V0; + + is( groupPosition("abccccd"), [ "cccc" ], "Example 1"); + is( groupPosition("aaabcddddeefff"), [ "aaa", "dddd", "fff" ], "Example 2"); + is( groupPosition("abcdd"), [ ], "Example 3"); + + done_testing; +} diff --git a/challenge-318/bob-lied/perl/ch-2.pl b/challenge-318/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..f1e1d79da7 --- /dev/null +++ b/challenge-318/bob-lied/perl/ch-2.pl @@ -0,0 +1,81 @@ +#!/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 318 Task 2 Reverse Equals +#============================================================================= +# You are given two arrays of integers, each containing the same elements +# as the other. Write a script to return true if one array can be made to +# equal the other by reversing exactly one contiguous subarray. +# Example 1 Input: @source = (3, 2, 1, 4); @target = (1, 2, 3, 4) +# Output: true +# Reverse elements: 0-2 +# +# Example 2 Input: @source = (1, 3, 4); @target = (4, 1, 3) +# Output: false +# +# Example 3 Input: @source = (2); @target = (2) +# Output: true +#============================================================================= + +use v5.40; + +use Getopt::Long; +my $DoTest = false; + +GetOptions("test" => \$DoTest); +#============================================================================= + +exit(!runTest()) if $DoTest; + +# Command line usage: two lists given as strings, +# Example: perl ch-2.pl "1 2 3 4" "1 3 2 4" + +say revEq( [split(/[\D]/, $ARGV[0])], [split(/[\D]/, $ARGV[1])]) ? "true" : "false"; + +#============================================================================= +sub revEq ($source, $target) +{ + use List::Util qw/zip/; + use List::MoreUtils qw/first_index last_index/; + + # Arrays must be the same size + return false if $source->$#* != $target->$#*; + + # Combine the two arrays into pairs + my @pair = zip($source, $target); + + # Find the left segment of equal elements + my $left = first_index { $_->[0] != $_->[1] } @pair; + + # If strings are equal, we can stop + return true if $left == -1; + + # Find the right segment of equal elements + my $right = last_index { $_->[0] != $_->[1] } @pair; + + # Extract the middle that could be reversed. + my @midsrc = $source->@[$left .. $right]; + my @midtrg = $target->@[$left .. $right]; + + # Check that one is the reverse of the other + while ( @midsrc && shift @midsrc == pop @midtrg ) {} + return @midsrc == 0; +} + +sub runTest +{ + use Test2::V0; + + is( revEq([3,2,1,4], [1,2,3,4]), true, "Example 1"); + is( revEq([1,3,4 ], [4,1,3 ]), false, "Example 2"); + is( revEq([2 ], [2 ]), true, "Example 3"); + + is( revEq([2,3,4,1], [2,3,4,1]), true, "Equal arrays"); + is( revEq([ ], [ ]), true, "Empty arrays"); + is( revEq([2,1,4,3], [2,3,4,1]), true, "Right side"); + is( revEq([2,1,4,3], [2,4,1,3]), true, "Middle"); + + done_testing; +} |