Perl Weekly Challenge 235.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 235.
Task 1: Remove One
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 #
4 # See https://wlmb.github.io/2023/09/18/PWC235/#task-1-remove-one
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
Task 2: Duplicate Zeros
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 #
4 # See https://wlmb.github.io/2023/09/18/PWC235/#task-2-duplicate-zeros
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