aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMohammad S Anwar <Mohammad.Anwar@yahoo.com>2023-05-02 10:25:31 +0100
committerGitHub <noreply@github.com>2023-05-02 10:25:31 +0100
commit02c9512b7408bd4a6cf45bafe85c784666e41b08 (patch)
tree863ad47f59cc81a1dabdd7461ff6a91d5e331210
parent76318dd1fb4b0ed28fd82ddd6f573fe759bec56f (diff)
parent448069bf4361bbb59a9036e21fedc8e233b82837 (diff)
downloadperlweeklychallenge-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.txt2
-rwxr-xr-xchallenge-215/wlmb/perl/ch-1.pl11
-rwxr-xr-xchallenge-215/wlmb/perl/ch-2.pl21
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;
+}