# 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
x y z -> 0
``````

The full code is essentially identical:

`````` 1  # Perl weekly challenge 215
2  # Task 1:  Odd one Out
3  #
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 x y z
``````

Results:

``````abc xyz tsu -> 1
x y z -> 0
``````

``````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  #
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 /^*\$/;
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
``````

/;

Written on May 1, 2023