Perl Weekly Challenge 235.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 235.

``````Submitted by: Mohammad S Anwar
You are given an array of integers.

Write a script to find out if removing ONLY one integer makes it strictly
increasing order.

Example 1
Input: @ints = (0, 2, 9, 4, 6)
Output: true

Removing ONLY 9 in the given array makes it strictly increasing order.
Example 2
Input: @ints = (5, 1, 3, 2)
Output: false
Example 3
Input: @ints = (2, 2, 3)
Output: true
``````

To solve the problem I move the numbers from an input array to an output sorted array counting the number of required deletions. If I delete more than one element, the result is false. The code fits a three-liner which is better explained in the full code below.

Example 1:

``````perl  -E '
sub t {return 1 if @i<=2;push @o, shift @i;while(@i){if(\$i[0]>\$o[-1]){
push @o, shift @i;}else{\$o[-1]=shift(@i);++\$c;return 0 if \$c>=2 || (@o>=2
&& \$o[-2]>= \$o[-1]);}}return 1;}@i=@ARGV;say "@ARGV -> ", t?"True":"False";
'  0 2 9 4 6
``````

Results:

``````0 2 9 4 6 -> True
``````

Example 2:

``````perl  -E '
sub t {return 1 if @i<=2;push @o, shift @i;while(@i){if(\$i[0]>\$o[-1]){
push @o, shift @i;}else{\$o[-1]=shift(@i);++\$c;return 0 if \$c>=2 || (@o>=2
&& \$o[-2]>= \$o[-1]);}}return 1;}@i=@ARGV;say "@ARGV -> ", t?"True":"False";
'  5 1 3 2
``````

Results:

``````5 1 3 2 -> False
``````

Example 3:

``````perl  -E '
sub t {return 1 if @i<=2;push @o, shift @i;while(@i){if(\$i[0]>\$o[-1]){
push @o, shift @i;}else{\$o[-1]=shift(@i);++\$c;return 0 if \$c>=2 || (@o>=2
&& \$o[-2]>= \$o[-1]);}}return 1;}@i=@ARGV;say "@ARGV -> ", t?"True":"False";
' 2 2 3
``````

Results:

``````2 2 3 -> True
``````

The full code follows.

`````` 1  # Perl weekly challenge 235
2  # Task 1:  Remove One
3  #
5  use v5.36;
6
7  sub test(@in) {
8      # Removing one element from a one or two element array yields an
9      # empty or a one element trivially sorted array
10      return 1 if @in<=2;
11      my \$count=0;
12      my @sorted;
13      push @sorted, shift @in;        # initialize
14      while(@in){
15  	if(\$in[0]>\$sorted[-1]){     # can move from @in to @sorted
16  			            # without disordering it?
17  	    push @sorted, shift @in;
18  	}else{                      # if not
19  	    \$sorted[-1]=shift(@in); # replace last element of @sorted
20  	    ++\$count;
21
22  	    return 0
23  		if \$count>=2        # fail if too many replacements or
24                                      # if @sorted is not actually ordered
25  		|| (@sorted>=2 && \$sorted[-2] >= \$sorted[-1]);
26  	}
27      }return 1;                      # success
28  }
29  die <<~"FIN" unless @ARGV;
30      Usage: \$0 N1 {N2...]
31      to find if the array N1, N2... becomes sorted by removing
32      only one element.
33      FIN
34  my @in=@ARGV;
35  my \$out=test(@in)?"True":"False";
36  say "@ARGV -> \$out";
``````

Examples:

``````./ch-1.pl 0 2 9 4 6
./ch-1.pl 5 1 3 2
./ch-1.pl 2 2 3
``````

Results:

``````0 2 9 4 6 -> True
5 1 3 2 -> False
2 2 3 -> True
``````

``````Submitted by: Mohammad S Anwar
You are given an array of integers.

Write a script to duplicate each occurrence of ZERO in the given array
and shift the remaining to the right but make sure the size of array remain the same.

Example 1
Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0)
Ouput: (1, 0, 0, 2, 3, 0, 0, 4)
Example 2
Input: @ints = (1, 2, 3)
Ouput: (1, 2, 3)
Example 3
Input: @ints = (0, 3, 0, 4, 5)
Ouput: (0, 0, 3, 0, 0)
``````

To solve this challenge I moved numbers from an input array to an output array. Whenever I see a zero, I push an additional zero and `pop` the last element of the input array, as it wouldn’t fit in the fixed size output. Care should be taken as the second zero may not fit into the output. The result fits a oneliner.

Example 1:

``````perl -E '
@i=@ARGV; while(@i){push @o, shift @i; pop @i, push @o,0 if @i && \$o[-1]==0;} say "@ARGV -> @o";
' 1 0 2 3 0 4 5 0
``````

Results:

``````1 0 2 3 0 4 5 0 -> 1 0 0 2 3 0 0 4
``````

Example 2:

``````perl -E '
@i=@ARGV; while(@i){push @o, shift @i; pop @i, push @o,0 if @i && \$o[-1]==0;} say "@ARGV -> @o";
' 1 2 3
``````

Results:

``````1 2 3 -> 1 2 3
``````

Example 3:

``````perl -E '
@i=@ARGV; while(@i){push @o, shift @i; pop @i, push @o,0 if @i && \$o[-1]==0;} say "@ARGV -> @o";
' 0 3 0 4 5
``````

Results:

``````0 3 0 4 5 -> 0 0 3 0 0
``````

The full code is almost identical:

`````` 1  # Perl weekly challenge 235
2  # Task 2:  Duplicate Zeros
3  #
5  use v5.36;
6  die <<~"FIN" unless @ARGV;
7      Usage: \$0 N1 [N2...]
8      to duplicate the zeroes in the array N1, N2...
9      without changing the size of the array
10      FIN
11  my @in=@ARGV;
12  my @out;
13  while(@in){
14      push @out, shift @in; # move from @in to @out
15      pop @in,              # remove last element
16      push @out, 0          # and duplicate zero
17      if @in                # if there is enough space
18      && \$out[-1]==0;       # and the last element was a 0
19  }
20  say "@ARGV -> @out";
``````

Examples:

``````./ch-2.pl 1 0 2 3 0 4 5 0
./ch-2.pl 1 2 3
./ch-2.pl 0 3 0 4 5
./ch-2.pl 3 0
./ch-2.pl 0 3 0 4
``````

Results:

``````1 0 2 3 0 4 5 0 -> 1 0 0 2 3 0 0 4
1 2 3 -> 1 2 3
0 3 0 4 5 -> 0 0 3 0 0
3 0 -> 3 0
0 3 0 4 -> 0 0 3 0
``````

The last two examples show that trailing zeroes are not duplicated.

Written on September 18, 2023