Perl Weekly Challenge 215.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 215.
Task 1: Odd one Out
Submitted by: Mohammad S Anwar
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
The words 'abc' and 'xyz' are sorted and can't be removed.
The word 'tsu' is not sorted and hence can be removed.
Example 2
Input: @words = ('rat', 'cab', 'dad')
Output: 3
None of the words in the given list are sorted.
Therefore all three needs to be removed.
Example 3
Input: @words = ('x', 'y', 'z')
Output: 0
I can solve this task by splitting each word into letters, sorting
them, joining them back and comparing them to the original word. I can
grep those that change and count them. This yields a small oneliner:
perl -E 'say "@ARGV -> ", 0+grep {(join "", sort {$a cmp $b} split "") ne $_} @ARGV' abc xyz tsu
perl -E 'say "@ARGV -> ", 0+grep {(join "", sort {$a cmp $b} split "") ne $_} @ARGV' rat cab dad
perl -E 'say "@ARGV -> ", 0+grep {(join "", sort {$a cmp $b} split "") ne $_} @ARGV' x y z
Results:
abc xyz tsu -> 1
rat cab dad -> 3
x y z -> 0
The full code is essentially identical:
1 # Perl weekly challenge 215
2 # Task 1: Odd one Out
3 #
4 # See https://wlmb.github.io/2023/05/01/PWC215/#task-1-odd-one-out
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 W1 [W2...]
8 to count words whose letters are not sorted
9 FIN
10 say "@ARGV -> ", 0+grep {(join "", sort {$a cmp $b} split "") ne $_} @ARGV;
Example:
./ch-1.pl abc xyz tsu
./ch-1.pl rat cab dad
./ch-1.pl x y z
Results:
abc xyz tsu -> 1
rat cab dad -> 3
x y z -> 0
Task 2: Number Placement
Submitted by: Mohammad S Anwar
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
You are asked to replace only one 0 as given count is 1.
We can easily replace middle 0 in the list i.e. (1,0,1,0,1).
Example 2:
Input: @numbers = (1,0,0,0,1), $count = 2
Output: 0
You are asked to replace two 0's as given count is 2.
It is impossible to replace two 0's.
Example 3:
Input: @numbers = (1,0,0,0,0,0,0,0,1), $count = 3
Output: 1
I guess that being the first number means there is no 1 to the left, and being the last means there is no 1 to the right, so 0,0,0 may become 1,0,1. To solve the challenge I assume the input is a string. I can use Perl’s substitute to add a 0 to the right and left and count how many groups of three consecutive zeroes there are, i.e., how many 000’s may be replaced, one at a time, from left to right, by ‘010’. This fits a oneliner.
Example 1:
perl -E '
($n, $x)=@ARGV; for($x){s/^/0/; s/$/0/; ++$c while s/000/010/; say "@ARGV->",$c>=$n?1:0}' 1 10001
Results:
1 10001->1
Example 2:
perl -E '
($n, $x)=@ARGV; for($x){s/^/0/; s/$/0/; ++$c while s/000/010/; say "@ARGV->",$c>=$n?1:0}' 2 10001
Results:
2 10001->0
Example 3:
perl -E '
($n, $x)=@ARGV; for($x){s/^/0/; s/$/0/; ++$c while s/000/010/; say "@ARGV->",$c>=$n?1:0}' 3 100000001
Results:
3 100000001->1
The full code adds a few checks.
1 # Perl weekly challenge 215
2 # Task 2: Number Placement
3 #
4 # See https://wlmb.github.io/2023/05/01/PWC215/#task-2-number-placement
5 use v5.36;
6 die <<~"FIN" unless @ARGV==2;
7 Usage: $0 N S
8 to find if I can replace N 1's in the string S consisting of 0's and 1's
9 Only 0's that don't have a 1 to their left nor right may be replaced.
10 FIN
11 my $count=shift;
12 my $copy=my $orig=shift;
13 for($copy){ # localize
14 die "Only 0's and 1's allowed. Invalid input: $_" unless /^[01]*$/;
15 s/^/0/; # add leading and trailing 0's
16 s/$/0/;
17 my $replacements=0;
18 $replacements++ while s/000/010/; # count replacements
19 say "Count: $count, string: $orig -> ", $replacements>=$count? 1:0;
20 }
Examples:
./ch-2.pl 1 10001
./ch-2.pl 2 10001
./ch-2.pl 3 100000001
Results:
Count: 1, string: 10001 -> 1
Count: 2, string: 10001 -> 0
Count: 3, string: 100000001 -> 1
/;