diff options
| author | Mohammad S Anwar <Mohammad.Anwar@yahoo.com> | 2023-05-02 10:25:31 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2023-05-02 10:25:31 +0100 |
| commit | 02c9512b7408bd4a6cf45bafe85c784666e41b08 (patch) | |
| tree | 863ad47f59cc81a1dabdd7461ff6a91d5e331210 | |
| parent | 76318dd1fb4b0ed28fd82ddd6f573fe759bec56f (diff) | |
| parent | 448069bf4361bbb59a9036e21fedc8e233b82837 (diff) | |
| download | perlweeklychallenge-club-02c9512b7408bd4a6cf45bafe85c784666e41b08.tar.gz perlweeklychallenge-club-02c9512b7408bd4a6cf45bafe85c784666e41b08.tar.bz2 perlweeklychallenge-club-02c9512b7408bd4a6cf45bafe85c784666e41b08.zip | |
Merge pull request #8007 from wlmb/challenges
Solve PWC215
| -rw-r--r-- | challenge-215/wlmb/blog.txt | 2 | ||||
| -rwxr-xr-x | challenge-215/wlmb/perl/ch-1.pl | 11 | ||||
| -rwxr-xr-x | challenge-215/wlmb/perl/ch-2.pl | 21 |
3 files changed, 34 insertions, 0 deletions
diff --git a/challenge-215/wlmb/blog.txt b/challenge-215/wlmb/blog.txt new file mode 100644 index 0000000000..e3c5c1f96a --- /dev/null +++ b/challenge-215/wlmb/blog.txt @@ -0,0 +1,2 @@ +https://wlmb.github.io/2023/05/01/PWC215/ + diff --git a/challenge-215/wlmb/perl/ch-1.pl b/challenge-215/wlmb/perl/ch-1.pl new file mode 100755 index 0000000000..857a09ea08 --- /dev/null +++ b/challenge-215/wlmb/perl/ch-1.pl @@ -0,0 +1,11 @@ +#!/usr/bin/env perl +# Perl weekly challenge 215 +# Task 1: Odd one Out +# +# See https://wlmb.github.io/2023/05/01/PWC215/#task-1-odd-one-out +use v5.36; +die <<~"FIN" unless @ARGV; + Usage: $0 W1 [W2...] + to count words whose letters are not sorted + FIN +say "@ARGV -> ", 0+grep {(join "", sort {$a cmp $b} split "") ne $_} @ARGV; diff --git a/challenge-215/wlmb/perl/ch-2.pl b/challenge-215/wlmb/perl/ch-2.pl new file mode 100755 index 0000000000..380aa5febd --- /dev/null +++ b/challenge-215/wlmb/perl/ch-2.pl @@ -0,0 +1,21 @@ +#!/usr/bin/env perl +# Perl weekly challenge 215 +# Task 2: Number Placement +# +# See https://wlmb.github.io/2023/05/01/PWC215/#task-2-number-placement +use v5.36; +die <<~"FIN" unless @ARGV==2; + Usage: $0 N S + to find if I can replace N 1's in the string S consisting of 0's and 1's + Only 0's that don't have a 1 to their left nor right may be replaced. + FIN +my $count=shift; +my $copy=my $orig=shift; +for($copy){ # localize + die "Only 0's and 1's allowed. Invalid input: $_" unless /^[01]*$/; + s/^/0/; # add leading and trailing 0's + s/$/0/; + my $replacements=0; + $replacements++ while s/000/010/; # count replacements + say "Count: $count, string: $orig -> ", $replacements>=$count? 1:0; +} |
