diff options
42 files changed, 1462 insertions, 4 deletions
diff --git a/challenge-337/e-choroba/perl/ch-1.pl b/challenge-337/e-choroba/perl/ch-1.pl new file mode 100755 index 0000000000..5db9dfe323 --- /dev/null +++ b/challenge-337/e-choroba/perl/ch-1.pl @@ -0,0 +1,36 @@ +#!/usr/bin/perl +use warnings; +use strict; +use experimental qw( signatures ); + +sub smaller_than_current(@num1) { + map { my $x = $_; scalar grep $_ < $x, @num1 } @num1 +} + +# Useful for large arrays with some values repeated. +sub smaller_than_current_fast(@num1) { + my %cache; + map { my $x = $_; $cache{$_} //= scalar grep $_ < $x, @num1 } @num1 +} + +use Test2::V0; +plan(2 * 5 + 1); + +for my $smaller_than_current (\&smaller_than_current, + \&smaller_than_current_fast +) { + is [$smaller_than_current->(6, 5, 4, 8)], [2, 1, 0, 3], 'Example 1'; + is [$smaller_than_current->(7, 7, 7, 7)], [0, 0, 0, 0], 'Example 2'; + is [$smaller_than_current->(5, 4, 3, 2, 1)], [4, 3, 2, 1, 0], 'Example 3'; + is [$smaller_than_current->(-1, 0, 3, -2, 1)], [1, 2, 4, 0, 3], 'Example 4'; + is [$smaller_than_current->(0, 1, 1, 2, 0)], [0, 2, 2, 4, 0], 'Example 5'; +} + +my @long = map int rand 1000, 1 .. 1_000; +is smaller_than_current(@long), smaller_than_current_fast(@long), 'same'; + +use Benchmark qw{ cmpthese }; +cmpthese(-3, { + naive => sub { smaller_than_current(@long) }, + optimized => sub { smaller_than_current_fast(@long) }, +}); diff --git a/challenge-337/e-choroba/perl/ch-2.pl b/challenge-337/e-choroba/perl/ch-2.pl new file mode 100755 index 0000000000..268fb7db52 --- /dev/null +++ b/challenge-337/e-choroba/perl/ch-2.pl @@ -0,0 +1,23 @@ +#!/usr/bin/perl +use warnings; +use strict; +use experimental qw( signatures ); + +use PDL; + +sub odd_matrix($row, $col, @locations) { + my $m = zeroes($col, $row); + for my $location (@locations) { + $m->slice($location->[1]) += 1; + $m->slice("", $location->[0]) += 1; + } + return ($m % 2)->sum +} + +use Test::More tests => 5; + +is odd_matrix(2, 3, [0, 1], [1, 1]), 6, 'Example 1'; +is odd_matrix(2, 2, [1, 1], [0, 0]), 0, 'Example 2'; +is odd_matrix(3, 3, [0, 0], [1, 2], [2, 1]), 0, 'Example 3'; +is odd_matrix(1, 5, [0, 2], [0, 4]), 2, 'Example 4'; +is odd_matrix(4, 2, [1, 0], [3, 1], [2, 0], [0, 1]), 8, 'Example 5'; diff --git a/challenge-339/conor-hoekstra/ch-1.bqn b/challenge-339/conor-hoekstra/ch-1.bqn new file mode 100644 index 0000000000..a54b321e16 --- /dev/null +++ b/challenge-339/conor-hoekstra/ch-1.bqn @@ -0,0 +1,28 @@ +# For up to date code: +# https://github.com/codereport/bqn-code/blob/main/pwc/339-1.bqn + +u ⇐ •Import "/home/cph/bqn-test/test.bqn" +fn ⇐ •Import "/home/cph/bqn-code/lib/fun.bqn" + +MaxProductDiff ← { ⌈´{ 𝕊a‿b‿c‿d: (a×b)-c×d }¨4 fn.ChooseWR 𝕩 } # solution 1 +MaxProductDiff2 ← { ⌈´{ -´×˝2‿2⥊𝕩 }¨4 fn.ChooseWR 𝕩 } # solution 2 (explicit) +MaxProductDiff3 ← ⌈´·(-´·×˝2‿2⊸⥊)¨4⊸fn.ChooseWR # solution 3 (tacit) + +# Tests +u.UnitTest (MaxProductDiff ⟨5, 9, 3, 4, 6⟩) ≡ 42 +u.UnitTest (MaxProductDiff ⟨1, ¯2, 3, ¯4⟩) ≡ 10 +u.UnitTest (MaxProductDiff ⟨¯3, ¯1, ¯2, ¯4⟩) ≡ 10 +u.UnitTest (MaxProductDiff ⟨10, 2, 0, 5, 1⟩) ≡ 50 +u.UnitTest (MaxProductDiff ⟨7, 8, 9, 10, 10⟩) ≡ 44 + +u.UnitTest (MaxProductDiff2 ⟨5, 9, 3, 4, 6⟩) ≡ 42 +u.UnitTest (MaxProductDiff2 ⟨1, ¯2, 3, ¯4⟩) ≡ 10 +u.UnitTest (MaxProductDiff2 ⟨¯3, ¯1, ¯2, ¯4⟩) ≡ 10 +u.UnitTest (MaxProductDiff2 ⟨10, 2, 0, 5, 1⟩) ≡ 50 +u.UnitTest (MaxProductDiff2 ⟨7, 8, 9, 10, 10⟩) ≡ 44 + +u.UnitTest (MaxProductDiff3 ⟨5, 9, 3, 4, 6⟩) ≡ 42 +u.UnitTest (MaxProductDiff3 ⟨1, ¯2, 3, ¯4⟩) ≡ 10 +u.UnitTest (MaxProductDiff3 ⟨¯3, ¯1, ¯2, ¯4⟩) ≡ 10 +u.UnitTest (MaxProductDiff3 ⟨10, 2, 0, 5, 1⟩) ≡ 50 +u.UnitTest (MaxProductDiff3 ⟨7, 8, 9, 10, 10⟩) ≡ 44 diff --git a/challenge-339/conor-hoekstra/ch-2.bqn b/challenge-339/conor-hoekstra/ch-2.bqn new file mode 100644 index 0000000000..367b144c92 --- /dev/null +++ b/challenge-339/conor-hoekstra/ch-2.bqn @@ -0,0 +1,13 @@ +# For up to date code: +# https://github.com/codereport/bqn-code/blob/main/pwc/339-2.bqn + +u ⇐ •Import "/home/cph/bqn-test/test.bqn" + +PeakPoint ← 0⌈´+` + +# Tests +u.UnitTest (PeakPoint ⟨¯5, 1, 5, ¯9, 2⟩) ≡ 1 +u.UnitTest (PeakPoint ⟨10, 10, 10, ¯25⟩) ≡ 30 +u.UnitTest (PeakPoint ⟨3, -4, 2, 5, ¯6, 1⟩) ≡ 6 +u.UnitTest (PeakPoint ⟨¯1, -2, -3, -4⟩) ≡ 0 +u.UnitTest (PeakPoint ⟨¯10, 15, 5⟩) ≡ 10 diff --git a/challenge-340/ash/raku/ch-1.raku b/challenge-340/ash/raku/ch-1.raku new file mode 100644 index 0000000000..1bd8d01199 --- /dev/null +++ b/challenge-340/ash/raku/ch-1.raku @@ -0,0 +1,13 @@ +# Task 1 of the Weekly Challenge 340 +# https://theweeklychallenge.org/blog/perl-weekly-challenge-340/#TASK1 + +say redup('abbaca'); # ca +say redup('azxxzy'); # ay +say redup('aaaaaaaa'); # '' +say redup('aabccba'); # a +say redup('abcddcba'); # '' + +sub redup($str is copy) { + while $str ~~ s:g/(.) $0// {}; + return $str; +} diff --git a/challenge-340/ash/raku/ch-2.raku b/challenge-340/ash/raku/ch-2.raku new file mode 100644 index 0000000000..caa4c3a5de --- /dev/null +++ b/challenge-340/ash/raku/ch-2.raku @@ -0,0 +1,12 @@ +# Task 2 of the Weekly Challenge 340 +# https://theweeklychallenge.org/blog/perl-weekly-challenge-340/#TASK2 + +say is-increasing('The cat has 3 kittens 7 toys 10 beds'); # True +say is-increasing('Alice bought 5 apples 2 oranges 9 bananas'); # False +say is-increasing('I ran 1 mile 2 days 3 weeks 4 months'); # True +say is-increasing('Bob has 10 cars 10 bikes'); # False +say is-increasing('Zero is 0 one is 1 two is 2'); # True + +sub is-increasing($str) { + [<] $str.comb(/\d+/) +} diff --git a/challenge-340/bob-lied/README.md b/challenge-340/bob-lied/README.md index 373adf6206..ea96334263 100644 --- a/challenge-340/bob-lied/README.md +++ b/challenge-340/bob-lied/README.md @@ -1,5 +1,5 @@ -# Solutions to weekly challenge 339 by Bob Lied +# Solutions to weekly challenge 340 by Bob Lied -## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-339/) -## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-339/bob-lied) -[Blog](https://dev.to/boblied/pwc-339-max-diff-sorting-for-the-win-43c8) +## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-340/) +## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-340/bob-lied) +[Blog](https://dev.to/boblied/) diff --git a/challenge-340/bob-lied/perl/ch-1.pl b/challenge-340/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..181939cbfe --- /dev/null +++ b/challenge-340/bob-lied/perl/ch-1.pl @@ -0,0 +1,60 @@ +#!/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 340 Task 1 Duplicate Removals +#============================================================================= +# You are given a string, $str, consisting of lowercase English letters. +# Write a script to return the final string after all duplicate removals +# have been made. Repeat duplicate removals on the given string until we +# no longer can. A duplicate removal consists of choosing two adjacent +# and equal letters and removing them. +# +# Example 1 Input: $str = 'abbaca' +# Output: 'ca' +# Step 1: Remove 'bb' => 'aaca' +# Step 2: Remove 'aa' => 'ca' +# Example 2 Input: $str = 'azxxzy' +# Output: 'ay' +# Example 3 Input: $str = 'aaaaaaaa' +# Output: '' +# Example 4 Input: $str = 'aabccba' +# Output: 'a' +# Example 5 Input: $str = 'abcddcba' +# Output: '' +#============================================================================= + +use v5.42; + + +use Getopt::Long; +my $Verbose = false; +my $DoTest = false; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +#============================================================================= + +exit(!runTest()) if $DoTest; + +say dupRmv($_) for @ARGV; + +#============================================================================= +sub dupRmv($str) +{ + while ( $str =~ s/(.)\1//g ) { } + return $str; +} + +sub runTest +{ + use Test2::V0; + + is( dupRmv('abbaca'), 'ca', "Example 1"); + is( dupRmv('azxxzy'), 'ay', "Example 2"); + is( dupRmv('aaaaaaaa'), '', "Example 3"); + is( dupRmv('aabccba'), 'a', "Example 4"); + is( dupRmv('abcddcba'), '', "Example 5"); + + done_testing; +} diff --git a/challenge-340/bob-lied/perl/ch-2.pl b/challenge-340/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..162a3b8b91 --- /dev/null +++ b/challenge-340/bob-lied/perl/ch-2.pl @@ -0,0 +1,137 @@ +#!/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 340 Task 2 Ascending Numbers +#============================================================================= +# You are given a string, $str, is a list of tokens separated by a single +# space. Every token is either a positive number consisting of digits 0-9 +# with no leading zeros, or a word consisting of lowercase English letters. +# Write a script to check if all the numbers in the given string are strictly +# increasing from left to right. +# Example 1 Input: $str = "The cat has 3 kittens 7 toys 10 beds" +# Output: true +# Example 2 Input: $str = 'Alice bought 5 apples 2 oranges 9 bananas' +# Output: false +# Example 3 Input: $str = 'I ran 1 mile 2 days 3 weeks 4 months' +# Output: true +# Example 4 Input: $str = 'Bob has 10 cars 10 bikes' +# Output: false +# Example 5 Input: $str = 'Zero is 0 one is 1 two is 2' +# Output: true +#============================================================================= + +use v5.42; + + +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 (isAscending($_) ? "true" : "false") for @ARGV; + +#============================================================================= +sub isAscending($str) +{ + my $isSorted = true; + my @num = grep /^\d+$/, split(" ", $str); + while ( defined(my $n = shift @num) && @num) + { + $isSorted &&= ($n < $num[0]); + } + return $isSorted; + # I'm taking the position that all lists are ascending unless + # proved otherwise, hence a list of 0 or 1 returns true. +} + +sub isAscending_slide($str) +{ + use List::MoreUtils qw/slide/; use List::Util qw/all/; + my @num = grep /^\d+$/, split(" ", $str); + return (@num < 2 ? true : all { $_ } slide { $a < $b } @num); +} + +sub isAscending_try($str) +{ + use List::MoreUtils qw/slide/; use List::Util qw/all/; + # Slide will throw if it doesn't have at least 2 elements to work on. + try { + all { $_ } slide { $a < $b } grep /^\d+$/, split(" ", $str); + } + catch ( $e ) { + return ($e =~ m/slide/); + } +} + +sub runTest +{ + use Test2::V0; + + my @func = ( + [ loop => \&isAscending ], + [ slide => \&isAscending_slide ], + [ trycatch => \&isAscending_try ], + ); + + my @case = ( + ['The cat has 3 kittens 7 toys 10 beds', true, "Example 1" ], + ['Alice bought 5 apples 2 oranges 9 bananas', false, "Example 2" ], + ['I ran 1 mile 2 days 3 weeks 4 months', true, "Example 3" ], + ['Bob has 10 cars 10 bikes', false, "Example 4" ], + ['Zero is 0 one is 1 two is 2', true, "Example 5" ], + ['no numbers here', true, "Zero numbers" ], + ['1 number here', true, "One numbers" ], + ['is this7a number9', true, "All really numbers, empty" ], + ['is 7 this8a number9 2', false, "Some not really numbers" ], + ); + + for ( @func ) + { + my ($name, $subref) = $_->@*; + foreach ( @case ) + { + my ($arg, $expect, $comment) = $_->@*; + is( $subref->($arg), $expect, "$name $comment"); + } + } + + done_testing; +} + +sub runBenchmark($repeat) +{ + use Benchmark qw/cmpthese/; + + my @str = ( + 'The cat has 3 kittens 7 toys 10 beds', + 'Alice bought 5 apples 2 oranges 9 bananas', + 'I ran 1 mile 2 days 3 weeks 4 months Bob has 10 cars 10 bikes', + 'Zero is 0 one is 1 two is 2 three is 3 four is 4 five is 5 six is 6', + 'no numbers here', + '1 number here', + 'is this7a number9', + 'is 7 this8a number9 2', + + join(" and ", 0..99), + ); + cmpthese($repeat, { + loop => sub { isAscending($_) for @str }, + slide => sub { isAscending_slide($_) for @str }, + trycatch => sub { isAscending_try($_) for @str }, + }); +} diff --git a/challenge-340/conor-hoekstra/ch-1.bqn b/challenge-340/conor-hoekstra/ch-1.bqn new file mode 100644 index 0000000000..c43f038cd2 --- /dev/null +++ b/challenge-340/conor-hoekstra/ch-1.bqn @@ -0,0 +1,14 @@ +# For up to date code: +# https://github.com/codereport/bqn-code/blob/main/pwc/340-1.bqn + +u ⇐ •Import "/home/cph/bqn-test/test.bqn" +fn ⇐ •Import "/home/cph/bqn-code/lib/fun.bqn" + +RemoveDuplicates ← (∾·(1<≠)◶⟨⊢,2⊸↓⟩¨fn.Group)⍟≠ + +# Tests +u.UnitTest (RemoveDuplicates "abbaca") ≡ "ca" +u.UnitTest (RemoveDuplicates "azxxzy") ≡ "ay" +u.UnitTest (RemoveDuplicates "aaaaaaaa") ≡ "" +u.UnitTest (RemoveDuplicates "aabccba") ≡ "a" +u.UnitTest (RemoveDuplicates "abcddcba") ≡ "" diff --git a/challenge-340/conor-hoekstra/ch-2.bqn b/challenge-340/conor-hoekstra/ch-2.bqn new file mode 100644 index 0000000000..904f0729c4 --- /dev/null +++ b/challenge-340/conor-hoekstra/ch-2.bqn @@ -0,0 +1,15 @@ +# For up to date code: +# https://github.com/codereport/bqn-code/blob/main/pwc/340-2.bqn + +u ⇐ •Import "/home/cph/bqn-test/test.bqn" +s ⇐ •Import "/home/cph/bqn-code/lib/string.bqn" +fn ⇐ •Import "/home/cph/bqn-code/lib/fun.bqn" + +AscendingNumbers ← ∧´0<·fn.Deltas s.Nats + +# Tests +u.UnitTest (AscendingNumbers "The cat has 3 kittens 7 toys 10 beds") ≡ 1 +u.UnitTest (AscendingNumbers "Alice bought 5 apples 2 oranges 9 bananas") ≡ 0 +u.UnitTest (AscendingNumbers "I ran 1 mile 2 days 3 weeks 4 months") ≡ 1 +u.UnitTest (AscendingNumbers "Bob has 10 cars 10 bikes") ≡ 0 +u.UnitTest (AscendingNumbers "Zero is 0 one is 1 two is 2") ≡ 1 diff --git a/challenge-340/e-choroba/perl/ch-1.pl b/challenge-340/e-choroba/perl/ch-1.pl new file mode 100755 index 0000000000..7704ac07aa --- /dev/null +++ b/challenge-340/e-choroba/perl/ch-1.pl @@ -0,0 +1,20 @@ +#!/usr/bin/perl +use warnings; +use strict; +use experimental qw( signatures ); + +sub duplicate_removals($str) { + 1 while $str =~ s/(.)\1//g; + return $str +} + +use Test::More tests => 5 + 2; + +is duplicate_removals('abbaca'), 'ca', 'Example 1'; +is duplicate_removals('azxxzy'), 'ay', 'Example 2'; +is duplicate_removals('aaaaaaaa'), "", 'Example 3'; +is duplicate_removals('aabccba'), 'a', 'Example 4'; +is duplicate_removals('abcddcba'), "", 'Example 5'; + +is duplicate_removals('aaa'), 'a', 'Odd length'; +is duplicate_removals('aabccdeedffbgg'), "", 'Many steps'; diff --git a/challenge-340/e-choroba/perl/ch-2.pl b/challenge-340/e-choroba/perl/ch-2.pl new file mode 100755 index 0000000000..8df9da1ad3 --- /dev/null +++ b/challenge-340/e-choroba/perl/ch-2.pl @@ -0,0 +1,34 @@ +#!/usr/bin/perl +use warnings; +use strict; +use experimental qw( signatures ); + +sub ascending_numbers($str) { + my @numbers = $str =~ /(\d+)/ag; + for my $i (1 .. $#numbers) { + return if $numbers[$i] <= $numbers[ $i - 1 ]; + } + return 1 +} + +use constant { true => !0, false => !1 }; +use Test2::V0; +plan(5 + 1); + +is ascending_numbers('The cat has 3 kittens 7 toys 10 beds'), + bool(true), + 'Example 1'; +is ascending_numbers('Alice bought 5 apples 2 oranges 9 bananas'), + bool(false), + 'Example 2'; +is ascending_numbers('I ran 1 mile 2 days 3 weeks 4 months'), + bool(true), + 'Example 3'; +is ascending_numbers('Bob has 10 cars 10 bikes'), + bool(false), + 'Example 4'; +is ascending_numbers('Zero is 0 one is 1 two is 2'), + bool(true), + 'Example 5'; + +is ascending_numbers('There are no numbers'), bool(true), 'No numbers'; diff --git a/challenge-340/feng-chang/raku/ch-1.raku b/challenge-340/feng-chang/raku/ch-1.raku new file mode 100755 index 0000000000..88a82f9a9e --- /dev/null +++ b/challenge-340/feng-chang/raku/ch-1.raku @@ -0,0 +1,6 @@ +#!/bin/env raku + +unit sub MAIN(Str:D $s is copy); + +$s .= subst(/(.)$0/) while $s.contains(/(.)$0/); +put $s; diff --git a/challenge-340/feng-chang/raku/ch-2.raku b/challenge-340/feng-chang/raku/ch-2.raku new file mode 100755 index 0000000000..37a7400b5a --- /dev/null +++ b/challenge-340/feng-chang/raku/ch-2.raku @@ -0,0 +1,5 @@ +#!/bin/env raku + +unit sub MAIN(Str:D $msg); + +put so [<] $msg.comb(/\d+/); diff --git a/challenge-340/feng-chang/raku/test.raku b/challenge-340/feng-chang/raku/test.raku new file mode 100755 index 0000000000..20ad3c057c --- /dev/null +++ b/challenge-340/feng-chang/raku/test.raku @@ -0,0 +1,28 @@ +#!/bin/env raku + +# The Weekly Challenge 340 +use Test; + +sub pwc-test(Str:D $script, Bool :$deeply? = False, *@input) { + my ($expect, $assertion) = @input.splice(*-2, 2); + my $p = run $script, |@input, :out; + if $deeply { + is-deeply $p.out.slurp(:close).chomp.words.Bag, $expect, $assertion; + } else { + is $p.out.slurp(:close).chomp, $expect, $assertion; + } +} + +# Task 1, Duplicate Removals +pwc-test './ch-1.raku', 'abbaca', 'ca', 'Duplicate Removals: abbaca => ca'; +pwc-test './ch-1.raku', 'azxxzy', 'ay', 'Duplicate Removals: azxxzy => ay'; +pwc-test './ch-1.raku', 'aaaaaaaa', '', 'Duplicate Removals: aaaaaaaa => ""'; +pwc-test './ch-1.raku', 'aabccba', 'a', 'Duplicate Removals: aabccba => a'; +pwc-test './ch-1.raku', 'abcddcba', '', 'Duplicate Removals: abcddcba => ""'; + +# Task 2, Ascending Numbers +pwc-test './ch-2.raku', 'The cat has 3 kittens 7 toys 10 beds', 'True', 'Ascending Numbers: "The cat has 3 kittens 7 toys 10 beds" => true'; +pwc-test './ch-2.raku', 'Alice bought 5 apples 2 oranges 9 bananas', 'False', 'Ascending Numbers: "Alice bought 5 apples 2 oranges 9 bananas" => false'; +pwc-test './ch-2.raku', 'I ran 1 mile 2 days 3 weeks 4 months', 'True', 'Ascending Numbers: "I ran 1 mile 2 days 3 weeks 4 months" => true'; +pwc-test './ch-2.raku', 'Bob has 10 cars 10 bikes', 'False', 'Ascending Numbers: "Bob has 10 cars 10 bikes" => false'; +pwc-test './ch-2.raku', 'Zero is 0 one is 1 two is 2', 'True', 'Ascending Numbers: "Zero is 0 one is 1 two is 2" => Ture'; diff --git a/challenge-340/lubos-kolouch/perl/ch-1.pl b/challenge-340/lubos-kolouch/perl/ch-1.pl new file mode 100644 index 0000000000..f466e17a75 --- /dev/null +++ b/challenge-340/lubos-kolouch/perl/ch-1.pl @@ -0,0 +1,52 @@ +#!/usr/bin/env perl +use v5.38; +use warnings; +use feature 'signatures'; + +=pod + +=head1 PURPOSE + +Implementation for The Weekly Challenge 340, Task 1: remove adjacent duplicate +characters repeatedly until the string stabilises. + +=head1 ALGORITHM + +We walk the input string from left to right, using an array as a stack. Whenever +we encounter a character matching the current stack top, we pop the stack, +effectively discarding the duplicate pair. Otherwise, we push the character. +When the scan completes, the stack content is the fully reduced string. + +=cut + +sub duplicate_removals ($str) { + _assert_plain_string($str); + + my @stack; + for my $char ( split //, $str ) { + if ( @stack && $stack[-1] eq $char ) { + pop @stack; + } + else { + push @stack, $char; + } + } + + return join q(), @stack; +} + +sub _assert_plain_string ($value) { + die 'Input must be a defined, non-reference string' + if !defined $value || ref $value; +} + +unless (caller) { + require Test::More; + Test::More->import( tests => 5 ); + + Test::More::is( duplicate_removals('abbaca'), 'ca', 'Example 1' ); + Test::More::is( duplicate_removals('azxxzy'), 'ay', 'Example 2' ); + Test::More::is( duplicate_removals('aaaaaaaa'), q(), 'Example 3' ); + Test::More::is( duplicate_removals('aabccba'), 'a', 'Example 4' ); + Test::More::is( duplicate_removals('abcddcba'), q(), 'Example 5' ); +} diff --git a/challenge-340/lubos-kolouch/perl/ch-2.pl b/challenge-340/lubos-kolouch/perl/ch-2.pl new file mode 100644 index 0000000000..3fe212b5c0 --- /dev/null +++ b/challenge-340/lubos-kolouch/perl/ch-2.pl @@ -0,0 +1,64 @@ +#!/usr/bin/env perl +use v5.38; +use warnings; +use feature 'signatures'; + +=pod + +=head1 PURPOSE + +Implementation for The Weekly Challenge 340, Task 2: decide whether the numeric +values embedded in a space-separated token stream form a strictly increasing +sequence. + +=head1 ALGORITHM + +We split the input on single spaces and process each token. Tokens matching the +pattern for non-negative integers without leading zeros are interpreted as +numbers. Each number is compared with the previously seen numeric value; the +sequence fails if we ever see a decrease or plateau. If no violation occurs, the +sequence is strictly increasing. + +=cut + +sub ascending_numbers ($str) { + _assert_plain_string($str); + + my $last; + for my $token ( split / /, $str ) { + next unless _is_valid_integer_token($token); + + my $value = 0 + $token; + return 0 if defined $last && $value <= $last; + $last = $value; + } + + return 1; +} + +sub _is_valid_integer_token ($token) { + return $token eq '0' || $token =~ /\A[1-9]\d*\z/; +} + +sub _assert_plain_string ($value) { + die 'Input must be a defined, non-reference string' + if !defined $value || ref $value; +} + +sub _bool_to_text ($bool) { + return $bool ? 'true' : 'false'; +} + |