diff options
| -rw-r--r-- | challenge-235/bob-lied/README | 6 | ||||
| -rw-r--r-- | challenge-235/bob-lied/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-235/bob-lied/perl/ch-1.pl | 142 | ||||
| -rw-r--r-- | challenge-235/bob-lied/perl/ch-2.pl | 86 |
4 files changed, 232 insertions, 3 deletions
diff --git a/challenge-235/bob-lied/README b/challenge-235/bob-lied/README index 260e5988c9..078b56c84e 100644 --- a/challenge-235/bob-lied/README +++ b/challenge-235/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 234 by Bob Lied +Solutions to weekly challenge 235 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-234/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-234/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-235/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-235/bob-lied diff --git a/challenge-235/bob-lied/blog.txt b/challenge-235/bob-lied/blog.txt new file mode 100644 index 0000000000..db7e36a16c --- /dev/null +++ b/challenge-235/bob-lied/blog.txt @@ -0,0 +1 @@ +https://dev.to/boblied/pwc-235-steppin-in-a-slide-zone-la6 diff --git a/challenge-235/bob-lied/perl/ch-1.pl b/challenge-235/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..76a280fae6 --- /dev/null +++ b/challenge-235/bob-lied/perl/ch-1.pl @@ -0,0 +1,142 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-1.pl Perl Weekly Challenge 235 Task 1 Remove One +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given an array of integers. +# Write a script to find out if removing ONLY one integer makes it +# strictly kincreasing order. +# Example 1 Input: @ints = (0, 2, 9, 4, 6) +# Output: true +# Removing ONLY 9 in the given array makes it strictly increasing order. +# Example 2 Input: @ints = (5, 1, 3, 2) +# Output: false +# Example 3 Input: @ints = (2, 2, 3) +# Output: true +#============================================================================= + +use v5.38; +use builtin qw(true false); no warnings "experimental::builtin"; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +sub removeOne(@ints) +{ + use List::Util qw/min/; + + return true if @ints < 3; + + my $rmvCount = 0; + + # Walk forward until we hit a descending step. + for ( my $i = 0 ; $i < $#ints && $rmvCount < 2 ; $i++ ) + { + next if $ints[$i+1] >= $ints[$i]; + + # How far backward would we have to go to get back in order? + my $back = 0; + for ( my $j = $i ; $j >= 0 && $ints[$j] > $ints[$i+1] && $back < 3; $j-- ) + { + $back++; + } + + # How far ahead would we have to go to get back in order? + my $ahead = 0; + for ( my $j = $i+1; $j <= $#ints && $ints[$j] <= $ints[$i] && $ahead < 3; $j++ ) + { + $ahead++; + } + $rmvCount += min($back, $ahead); + + } + return $rmvCount < 2; +} + +sub runTest +{ + use Test2::V0; + no warnings "experimental::builtin"; + + is( removeOne(0,2,9,4,6), true, "Example 1"); + is( removeOne(5,1,3,2 ), false, "Example 2"); + is( removeOne(2,2,3 ), true, "Example 3"); + is( removeOne(10,1,2,3 ), true, "First element goes"); + is( removeOne(10,11,1 ), true, "Last element goes"); + is( removeOne(10,20,30,24,25,40), true, "One high peak"); + is( removeOne(10,20,30,18,25,40), false, "One high, one low"); + is( removeOne(1,2,5,3,4,6,3,4), false, "Multiple disorders"); + is( removeOne(99, 1000, 1..999, 2000), false, "Long failure"); + + # is( ro_A(0,2.9,4,6), true, "Example 1"); + # is( ro_A(5,1,3,2 ), false, "Example 2"); + # is( ro_A(2,2,3 ), true, "Example 3"); + + # is( ro_B(0,2.9,4,6), true, "Example 1"); + # is( ro_B(5,1,3,2 ), false, "Example 2"); + # is( ro_B(2,2,3 ), true, "Example 3"); + + # is( ro_C(0,2.9,4,6), true, "Example 1"); + # is( ro_C(5,1,3,2 ), false, "Example 2"); + # is( ro_C(2,2,3 ), true, "Example 3"); + + done_testing; +} + +# Things that don't work. + +# Move down the list in pairs and count the number of times that +# we find a decreasing pair. Stop when we hit the second one. +sub ro_D(@ints) +{ + my $rmvCount = 0; + for ( my $i = 0; $i < $#ints && $rmvCount < 2 ; $i++ ) + { + $rmvCount++ if $ints[$i+1] < $ints[$i]; + } + return $rmvCount < 2; +} + +# Map each pair to true/false for being sorted ascending. Count the falses. +# Will be inefficient if the list is long and the out-of-order elements are +# near the front. +sub ro_A(@ints) +{ + my $rmvCount = grep { $_ == false } + map { $ints[$_] < $ints[$_+1] } 0 .. ( $#ints-1 ); + return $rmvCount < 2; +} + +# Slide down the list in pairs and count the number of items that +# are out of order. Always scans the whole list. +sub ro_B(@ints) +{ + use List::MoreUtils qw/slide/; + my $rmvCount = 0; + slide { $rmvCount++ if ( $b < $a ) } @ints; + return $rmvCount < 2; +} + +# Use try/catch to quit early from slide +sub ro_C(@ints) +{ + use List::MoreUtils qw/slide/; + use feature 'try'; no warnings "experimental::try"; + my $rmvOne = true; + try { + my $rmvCount = 0; + slide { do { die if ++$rmvCount > 1 } if ( $b < $a ) } @ints; + } + catch ($e) + { + $rmvOne = false; + } + return $rmvOne; +} + diff --git a/challenge-235/bob-lied/perl/ch-2.pl b/challenge-235/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..0a7b0febf7 --- /dev/null +++ b/challenge-235/bob-lied/perl/ch-2.pl @@ -0,0 +1,86 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge 235 Task 2 Duplicate Zeros +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given an array of integers. +# Write a script to duplicate each occurrence of ZERO in the given array +# and shift the remaining to the right but make sure the size of array +# remain the same. +# Example 1 Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0) +# Ouput: (1, 0, 0, 2, 3, 0, 0, 4) +# Example 2 Input: @ints = (1, 2, 3) +# Ouput: (1, 2, 3) +# Example 3 Input: @ints = (0, 3, 0, 4, 5) +# Ouput: (0, 0, 3, 0, 0) +#============================================================================= + +use v5.36; + +use FindBin qw($Bin); +use lib "$FindBin::Bin"; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +sub duplicateZeros(@ints) +{ + [ (map { $_ || (0,0) } @ints)[0 .. $#ints] ] +} + +sub dz_A(@ints) +{ + my $maxLen = @ints; + my @output; + while ( @output < $maxLen ) + { + push @output, shift @ints; + push @output, 0 if ( $output[-1] == 0 && @output < $maxLen ); + } + return \@output; +} + +sub dz_B(@ints) +{ + for (my $i = 0 ; $i <= $#ints; $i++ ) + { + if ( $ints[$i] == 0 ) + { + # Insert a zero and advance i past it + splice(@ints, $i++, 0, 0); + pop @ints; # Maintain the length; + } + } + return \@ints; +} + +sub runTest +{ + use Test2::V0; + + is( duplicateZeros(1,0,2,3,0,4,5,0), [1,0,0,2,3,0,0,4], "Example 1"); + is( duplicateZeros(1,2,3 ), [1,2,3 ], "Example 2"); + is( duplicateZeros(0,3,0,4,5 ), [0,0,3,0,0 ], "Example 3"); + is( duplicateZeros(0), [0], "One Zero"); + is( duplicateZeros(2, 1, 0), [2, 1, 0], "Ends on a zero"); + + is( dz_A(1,0,2,3,0,4,5,0), [1,0,0,2,3,0,0,4], "Example 1"); + is( dz_A(1,2,3 ), [1,2,3 ], "Example 2"); + is( dz_A(0,3,0,4,5 ), [0,0,3,0,0 ], "Example 3"); + is( dz_A(0), [0], "One Zero"); + is( dz_A(2, 1, 0), [2, 1, 0], "Ends on a zero"); + + is( dz_B(1,0,2,3,0,4,5,0), [1,0,0,2,3,0,0,4], "Example 1"); + is( dz_B(1,2,3 ), [1,2,3 ], "Example 2"); + is( dz_B(0,3,0,4,5 ), [0,0,3,0,0 ], "Example 3"); + is( dz_B(0), [0], "One Zero"); + is( dz_B(2, 1, 0), [2, 1, 0], "Ends on a zero"); + + done_testing; +} |