diff options
| -rw-r--r-- | challenge-215/bob-lied/README | 6 | ||||
| -rw-r--r-- | challenge-215/bob-lied/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-215/bob-lied/perl/ch-1.pl | 76 | ||||
| -rw-r--r-- | challenge-215/bob-lied/perl/ch-2.pl | 76 |
4 files changed, 156 insertions, 3 deletions
diff --git a/challenge-215/bob-lied/README b/challenge-215/bob-lied/README index 4f6ce65387..386b265dbc 100644 --- a/challenge-215/bob-lied/README +++ b/challenge-215/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 214 by Bob Lied +Solutions to weekly challenge 215 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-214/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-214/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-215/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-215/bob-lied diff --git a/challenge-215/bob-lied/blog.txt b/challenge-215/bob-lied/blog.txt new file mode 100644 index 0000000000..4c8f4d6543 --- /dev/null +++ b/challenge-215/bob-lied/blog.txt @@ -0,0 +1 @@ +https://dev.to/boblied/pwc-215-odd-one-out-number-placement-2cc9 diff --git a/challenge-215/bob-lied/perl/ch-1.pl b/challenge-215/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..dab3fb89e0 --- /dev/null +++ b/challenge-215/bob-lied/perl/ch-1.pl @@ -0,0 +1,76 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-1.pl Perl Weekly Challenge 215 Task 1 Odd One Out +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given a list of words (alphabetic characters only) of same size. +# Write a script to remove all words not sorted alphabetically and print the +# number of words in the list that are not alphabetically sorted. +# Example 1 Input: @words = ('abc', 'xyz', 'tsu') Output: 1 +# Example 2 Input: @words = ('rat', 'cab', 'dad') Output: 3 +# Example 3 Input: @words = ('x', 'y', 'z') Output: 0 +#============================================================================= + +use v5.36; + +use builtin qw/true false/; no warnings "experimental::builtin"; + +binmode(STDOUT, ':utf8'); +binmode(STDERR, ':utf8'); + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +say oddOneOut(@ARGV); + +sub isOrdered($word) +{ + use Unicode::Collate; + state $Collator = Unicode::Collate->new(); + + my @char = split(//, lc($word)); + my $first = shift @char; + while ( my $next = shift @char ) + { + return false if $Collator->gt($first, $next) > 0; + $first = $next; + } + return true; +} + +sub oddOneOut(@words) +{ + use List::Util qw/all/; + + return 0 unless @words; + my $wordLength = length($words[0]); + return 0 unless all { length($_) == $wordLength } @words; + + my $removeCount = grep { not isOrdered($_) } @words; + + return $removeCount; +} + +sub runTest +{ + use Test2::V0; + + is(oddOneOut( ), 0, "Empty list"); + is(oddOneOut('', '', '' ), 0, "Empty strings"); + is(oddOneOut(qw(xyzz )), 0, "One word sorted"); + is(oddOneOut(qw(xyzzy )), 1, "One word out"); + is(oddOneOut(qw(abc xyz tsu)), 1, "Example 1"); + is(oddOneOut(qw(rat cab dad)), 3, "Example 2"); + is(oddOneOut(qw(x y z )), 0, "Example 3"); + is(oddOneOut(qw(xyz de m )), 0, "Different lengths"); + is(oddOneOut(qw(mío año del)), 1, "Spanish"); + + done_testing; +} + diff --git a/challenge-215/bob-lied/perl/ch-2.pl b/challenge-215/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..d8f6e68d30 --- /dev/null +++ b/challenge-215/bob-lied/perl/ch-2.pl @@ -0,0 +1,76 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge Task 2 Number Placement +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given a list of numbers having just 0 and 1. You are also given +# placement count (>=1). +# Write a script to find out if it is possible to replace 0 with 1 in the +# given list. The only condition is that you can only replace when there is +# no 1 on either side. Print 1 if it is possible otherwise 0. +# Example 1: Input: @numbers = (1,0,0,0,1), $count = 1 Output: 1 +# Example 2: Input: @numbers = (1,0,0,0,1), $count = 2 Output: 0 +# Example 3: Input: @numbers = (1,0,0,0,0,0,0,0,1), $count = 3 Output: 1 +#============================================================================= + +use v5.36; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; +my $Count = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "count:i" => \$Count); +exit(!runTest()) if $DoTest; + +sub usage { "Usage: $0 -c COUNT [1|0]..." } + +my @list = @ARGV; + +do { say usage(); exit 1; } if @list == 0 || grep !/^[01]$/, @list; + +if ( $Verbose ) +{ + my $copy = [ @list ]; + my $canReplace = numberPlacement($copy, $Count); + say $canReplace; + say STDERR "(@list) --> $Count replacements\n(@$copy)" if $canReplace; +} +else +{ + say numberPlacement(\@list, $Count); +} + + +sub numberPlacement($list, $count) +{ + for ( my $i = 2; $count && $i <= $list->$#* ; $i++ ) + { + if ( $list->[$i-2] == 0 && $list->[$i-1] == 0 && $list->[$i] == 0 ) + { + $list->[$i-1] = 1; + $count--; + } + } + return ( $count == 0 ? 1 : 0 ); +} + +sub runTest +{ + use Test2::V0; + + is(numberPlacement([1,0,0,0,1], 1), 1, "Example 1"); + is(numberPlacement([1,0,0,0,1], 2), 0, "Example 2"); + is(numberPlacement([1,0,0,0,0,0,0,0,1], 3), 1, "Example 3"); + is(numberPlacement([0,0,1], 1), 0, "Small fail"); + is(numberPlacement([0,0,0], 1), 1, "Small success"); + is(numberPlacement([1,0 ], 2), 0, "Too small"); + is(numberPlacement([0,0,1,0,0,1,0,0,1], 2), 0, "No cigar"); + is(numberPlacement([0,0,0,0,0,1,0,0,1], 2), 1, "Two cigars"); + is(numberPlacement([0,0,0,0,0,0,0,0,0], 4), 1, "Four cigars"); + is(numberPlacement([0,0,0,0,0,0,0,0,0], 5), 0, "Don't get greedy"); + + done_testing; +} |