Perl Weekly Challenge 202.

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

Task 1: Consecutive Odds

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

Write a script to print 1 if there are THREE consecutive odds in the given array otherwise print 0.


Example 1
Input: @array = (1,5,3,6)
Output: 1
Example 2
Input: @array = (2,6,3,5)
Output: 0
Example 3
Input: @array = (1,2,3,4)
Output: 0
Example 4
Input: @array = (2,3,5,7)
Output: 1

To solve this challenge I filter out even numbers, order the array of odd numbers and test groups of succesive groups of three for consecutiveness, stopping at the first found. This fits a two liner:

perl -E '$o=0;for(sort {$a <=> $b} grep {$_%2} @ARGV){($u,$d,$t)=($d,$t,$_);
$o=1, last if $u+4==$d+2==$t} say(join " ", @ARGV, "-> $o");
' 1 5 3 6
perl -E '$o=0;for(sort {$a <=> $b} grep {$_%2} @ARGV){($u,$d,$t)=($d,$t,$_);
$o=1, last if $u+4==$d+2==$t} say(join " ", @ARGV, "-> $o");
' 2 6 3 5
perl -E '$o=0;for(sort {$a <=> $b} grep {$_%2} @ARGV){($u,$d,$t)=($d,$t,$_);
$o=1, last if $u+4==$d+2==$t} say(join " ", @ARGV, "-> $o");
' 1 2 3 4
perl -E '$o=0;for(sort {$a <=> $b} grep {$_%2} @ARGV){($u,$d,$t)=($d,$t,$_);
$o=1, last if $u+4==$d+2==$t} say(join " ", @ARGV, "-> $o");
' 2 3 5 7

Results:

1 5 3 6 -> 1
2 6 3 5 -> 0
1 2 3 4 -> 0
2 3 5 7 -> 1

The full code is:

 1  # Perl weekly challenge 202
 2  # Task 1:  Consecutive Odds
 3  #
 4  # See https://wlmb.github.io/2023/01/30/PWC202/#task-1-consecutive-odds
 5  use v5.36;
 6  my $out=0;
 7  my ($u, $d, $t);
 8  for(sort {$a <=> $b} grep {$_%2} @ARGV){
 9      ($u,$d,$t)=($d,$t,$_); # Current three elements
10      $out=1, last if $u+4==$d+2==$t
11  }
12  say(join " ", @ARGV, "-> $out");

Examples:

./ch-1.pl 1 5 3 6
./ch-1.pl 2 6 3 5
./ch-1.pl 1 2 3 4
./ch-1.pl 2 3 5 7

Results:

1 5 3 6 -> 1
2 6 3 5 -> 0
1 2 3 4 -> 0
2 3 5 7 -> 1

Task 2: Widest Valley

Submitted by: E. Choroba
Given a profile as a list of altitudes, return the leftmost widest valley. A valley is defined as a subarray of the profile consisting of two parts: the first part is non-increasing and the second part is non-decreasing. Either part can be empty.


Example 1
Input: 1, 5, 5, 2, 8
Output: 5, 5, 2, 8
Example 2
Input: 2, 6, 8, 5
Output: 2, 6, 8
Example 3
Input: 9, 8, 13, 13, 2, 2, 15, 17
Output: 13, 13, 2, 2, 15, 17
Example 4
Input: 2, 1, 2, 1, 3
Output: 2, 1, 2
Example 5
Input: 1, 3, 3, 2, 1, 2, 3, 3, 2
Output: 3, 3, 2, 1, 2, 3, 3

To solve this challenge I loop over the inputs updating two arrays with valleys under construction: @down for a descending leg of the trip through the landscape, and @up for an ascending leg.

  1. For each new height:
    1. If the current value is higher than the previous one, I’m in an ascending stage.
      1. At the transition, I copy @up=~@down, i.e., the previous downwards trip is part of the current upwards one.
      2. I empty the descending stage.
    2. If the current value is lower than the previous one, I’m in a descending stage.
      1. The current ascending stage has finished, so I’m leaving the corresponding valley. I send it to the @out array.
      2. I empty the ascending stage.
    3. I push the current value to the end of both the upwards and downwards legs.

The corresponding code is the following:

 1  # Perl weekly challenge 202
 2  # Task 2:  Widest Valley
 3  #
 4  # See https://wlmb.github.io/2023/01/30/PWC202/#task-2-widest-valley
 5  use v5.36;
 6  use List::UtilsBy qw(max_by);
 7  die <<~"FIN" unless @ARGV;
 8      Usage: $0 N1 [N2...]
 9      to find the widest valley in the sequence N1 N2...
10      FIN
11
12  my @in=@ARGV;
13  my $ascending=0;
14  my @up=my @down=(my $previous=shift);
15  my @out;
16  for(@ARGV){
17      if($_>$previous){
18  	@up=@down unless $ascending;
19  	@down=();
20  	$ascending=1;
21      }
22      if($_<$previous){
23  	push @out, [@up];
24          @up=();
25  	$ascending=0;
26      }
27      push @down, $_;
28      push @up, $_;
29      $previous=$_;
30  }
31  push @out, [@down], [@up];
32  my $result=max_by {@$_} @out;
33  say join " ", @in, "->", @$result;

Examples:

./ch-2.pl  1 5 5 2 8
./ch-2.pl  2 6 8 5
./ch-2.pl  9 8 13 13 2 2 15 17
./ch-2.pl  2 1 2 1 3
./ch-2.pl  1 3 3 2 1 2 3 3 2

Results:

1 5 5 2 8 -> 5 5 2 8
2 6 8 5 -> 2 6 8
9 8 13 13 2 2 15 17 -> 13 13 2 2 15 17
2 1 2 1 3 -> 2 1 2
1 3 3 2 1 2 3 3 2 -> 3 3 2 1 2 3 3

The code above can fit a two liner:

perl -MList::UtilsBy=max_by -E '
$a==0;@u=@d=($c=shift);for(@ARGV){if($_>$c){@u=@d unless $a; @d=();$a=1;}if($_<$c){push @o, [@u];
@u=(); $a=0;}push @u, $_; push @d, $c=$_;}push @o, [@d], [@u];$r=max_by {@$_} @o;  say join " ", @$r;
' 1 5 5 2 8
perl -MList::UtilsBy=max_by -E '
$a==0;@u=@d=($c=shift);for(@ARGV){if($_>$c){@u=@d unless $a; @d=();$a=1;}if($_<$c){push @o, [@u];
@u=(); $a=0;}push @u, $_; push @d, $c=$_;}push @o, [@d], [@u];$r=max_by {@$_} @o;  say join " ", @$r;
' 2 6 8 5
perl -MList::UtilsBy=max_by -E '
$a==0;@u=@d=($c=shift);for(@ARGV){if($_>$c){@u=@d unless $a; @d=();$a=1;}if($_<$c){push @o, [@u];
@u=(); $a=0;}push @u, $_; push @d, $c=$_;}push @o, [@d], [@u];$r=max_by {@$_} @o;  say join " ", @$r;
' 9 8 13 13 2 2 15 17
perl -MList::UtilsBy=max_by -E '
$a==0;@u=@d=($c=shift);for(@ARGV){if($_>$c){@u=@d unless $a; @d=();$a=1;}if($_<$c){push @o, [@u];
@u=(); $a=0;}push @u, $_; push @d, $c=$_;}push @o, [@d], [@u];$r=max_by {@$_} @o;  say join " ", @$r;
' 2 1 2 1 3
perl -MList::UtilsBy=max_by -E '
$a==0;@u=@d=($c=shift);for(@ARGV){if($_>$c){@u=@d unless $a; @d=();$a=1;}if($_<$c){push @o, [@u];
@u=(); $a=0;}push @u, $_; push @d, $c=$_;}push @o, [@d], [@u];$r=max_by {@$_} @o;  say join " ", @$r;
' 1 3 3 2 1 2 3 3 2

Results:

5 5 2 8
2 6 8
13 13 2 2 15 17
2 1 2
3 3 2 1 2 3 3
Written on January 30, 2023