# Perl Weekly Challenge 189.

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

``````Submitted by: Mohammad S Anwar
You are given an array of characters (a..z) and a target character.

Write a script to find out the smallest character in the given array
lexicographically greater than the target character.

Example 1
Input: @array = qw/e m u g/, \$target = 'b'
Output: e
Example 2
Input: @array = qw/d c e f/, \$target = 'a'
Output: c
Example 3
Input: @array = qw/j a r/, \$target = 'o'
Output: r
Example 4
Input: @array = qw/d c a f/, \$target = 'a'
Output: c
Example 5
Input: @array = qw/t g a l/, \$target = 'v'
Output: v
``````

The last example is somewhat confusing. Why is the answer ‘v’ instead of `undef`? ‘v’ is not a member of the array and it is not greater than ‘v’. Does it mean that I should add the target to the array and use a ‘ge’ instead of a ‘gt’ comparison, or use the target as a default answer when there is no other? I use the latter interpretation. The task is a simple oneliner using `first` from `List::Util`.

``````perl -MList::Util=first -E '(\$t,@x)=@ARGV; say join " ", @x, ": \$t ->", (first {\$_ gt \$t} sort @x)//\$t;' b e m u g
perl -MList::Util=first -E '(\$t,@x)=@ARGV; say join " ", @x, ": \$t ->", (first {\$_ gt \$t} sort @x)//\$t;' a d c e f
perl -MList::Util=first -E '(\$t,@x)=@ARGV; say join " ", @x, ": \$t ->", (first {\$_ gt \$t} sort @x)//\$t;' o j a r
perl -MList::Util=first -E '(\$t,@x)=@ARGV; say join " ", @x, ": \$t ->", (first {\$_ gt \$t} sort @x)//\$t;' a d c a f
perl -MList::Util=first -E '(\$t,@x)=@ARGV; say join " ", @x, ": \$t ->", (first {\$_ gt \$t} sort @x)//\$t;' v t g a l
``````

The full version is

`````` 1  # Perl weekly challenge 189
2  # Task 1:  Greater Character
3  #
5  use v5.36;
6  use List::Util qw(first all);
7  die <<"EOF" unless @ARGV>1;
8  Usage: \$0 target c1 c2...
9  To find smallest char ci larger than target
10  EOF
11  die "Only single chars in range a..z allowed" unless all {/^[a-z]\$/} @ARGV;
12  my (\$target,@array)=@ARGV;
13  say join " ", @array, ": \$target ->",
14      (first {\$_ gt \$target} sort @array) # smallest char after target or
15      //\$target;                          # funny default
``````

Example:

``````./ch-1.pl b e m u g
./ch-1.pl a d c e f
./ch-1.pl o j a r
./ch-1.pl a d c a f
./ch-1.pl v t g a l
``````

Results:

``````e m u g : b -> e
d c e f : a -> c
j a r : o -> r
d c a f : a -> c
t g a l : v -> v
``````

``````Submitted by: Mohammad S Anwar
You are given an array of 2 or more non-negative integers.

Write a script to find out the smallest slice, i.e. contiguous subarray
of the original array, having the degree of the given array.

The degree of an array is the maximum frequency of an element in the array.

Example 1
Input: @array = (1, 3, 3, 2)
Output: (3, 3)

The degree of the given array is 2.
The possible subarrays having the degree 2 are as below:
(3, 3)
(1, 3, 3)
(3, 3, 2)
(1, 3, 3, 2)

And the smallest of all is (3, 3).
Example 2
Input: @array = (1, 2, 1, 3)
Output: (1, 2, 1)
Example 3
Input: @array = (1, 3, 2, 1, 2)
Output: (2, 1, 2)
Example 4
Input: @array = (1, 1, 2, 3, 2)
Output: (1, 1)
Example 5
Input: @array = (2, 1, 2, 1, 1)
Output: (1, 2, 1, 1)
``````

The resulting slice must start and end with the same number, as otherwise, we could drop leading or trailing elements without changing the degree and shortening the slice. Thus, a solution may be found by registering the first and last appearance of every number, as well as its frequency and the length of the corresponding slice. This allows a two liner solution. I took advantage of the experimental `for_list` and `buitin::indexed` functions of v5.36.

``````perl -Mexperimental=for_list,builtin -E '
@x=@ARGV; for my(\$i,\$v)(builtin::indexed @x){++\$r{\$v}; \$f{\$v}//=\$i; \$l{\$v}=\$i; \$d{\$v}=\$l{\$v}-\$f{\$v};
\$k=\$v if(\$r{\$k}<\$r{\$v}||\$r{\$k}==\$r{\$v}&&\$d{\$k}>\$d{\$v})} say join " ",@x, "->", @x[\$f{\$k}..\$l{\$k}];
' 1 3 3 2
perl -Mexperimental=for_list,builtin -E '
@x=@ARGV; for my(\$i,\$v)(builtin::indexed @x){++\$r{\$v}; \$f{\$v}//=\$i; \$l{\$v}=\$i; \$d{\$v}=\$l{\$v}-\$f{\$v};
\$k=\$v if(\$r{\$k}<\$r{\$v}||\$r{\$k}==\$r{\$v}&&\$d{\$k}>\$d{\$v})} say join " ",@x, "->", @x[\$f{\$k}..\$l{\$k}];
' 1 2 1 3
perl -Mexperimental=for_list,builtin -E '
@x=@ARGV; for my(\$i,\$v)(builtin::indexed @x){++\$r{\$v}; \$f{\$v}//=\$i; \$l{\$v}=\$i; \$d{\$v}=\$l{\$v}-\$f{\$v};
\$k=\$v if(\$r{\$k}<\$r{\$v}||\$r{\$k}==\$r{\$v}&&\$d{\$k}>\$d{\$v})} say join " ",@x, "->", @x[\$f{\$k}..\$l{\$k}];
' 1 3 2 1 2
perl -Mexperimental=for_list,builtin -E '
@x=@ARGV; for my(\$i,\$v)(builtin::indexed @x){++\$r{\$v}; \$f{\$v}//=\$i; \$l{\$v}=\$i; \$d{\$v}=\$l{\$v}-\$f{\$v};
\$k=\$v if(\$r{\$k}<\$r{\$v}||\$r{\$k}==\$r{\$v}&&\$d{\$k}>\$d{\$v})} say join " ",@x, "->", @x[\$f{\$k}..\$l{\$k}];
' 1 1 2 3 2
perl -Mexperimental=for_list,builtin -E '
@x=@ARGV; for my(\$i,\$v)(builtin::indexed @x){++\$r{\$v}; \$f{\$v}//=\$i; \$l{\$v}=\$i; \$d{\$v}=\$l{\$v}-\$f{\$v};
\$k=\$v if(\$r{\$k}<\$r{\$v}||\$r{\$k}==\$r{\$v}&&\$d{\$k}>\$d{\$v})} say join " ",@x, "->", @x[\$f{\$k}..\$l{\$k}];
' 2 1 2 1 1
``````

Results:

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

The full code is

`````` 1  # Perl weekly challenge 189
2  # Task 2:  Array Degree
3  #
5  use v5.36;
6  use experimental qw(for_list builtin);
7  my %degree;
8  my (%degree_of, %beginning_of, %ending_of, %length_of);
9  my \$current;
10  for my(\$index,\$value)(builtin::indexed @ARGV){
11      ++\$degree_of{\$value};
12      \$beginning_of{\$value}//=\$index;  # starting index if previously unseen
13      \$ending_of{\$value}=\$index;       # last seen index
14      \$length_of{\$value}=\$ending_of{\$value}-\$beginning_of{\$value};
15      \$current=\$value
16          if(\$degree_of{\$current}<\$degree_of{\$value} # update \$current if found better
17             || \$degree_of{\$current}==\$degree_of{\$value}
18                && \$length_of{\$current}>\$length_of{\$value});
19  }
20  say join " ", @ARGV, "->", @ARGV[\$beginning_of{\$current}..\$ending_of{\$current}];
``````

Example:

``````./ch-2.pl 1 3 3 2
./ch-2.pl 1 2 1 3
./ch-2.pl 1 3 2 1 2
./ch-2.pl 1 1 2 3 2
./ch-2.pl 2 1 2 1 1
``````

Results:

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

;)

Written on October 31, 2022