Perl Weekly Challenge 189.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 189.
Task 1: Greater Character
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 #
4 # See https://wlmb.github.io/2022/10/31/PWC189/#task-1-greater-character
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
Task 2: Array Degree
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 #
4 # See https://wlmb.github.io/2022/10/31/PWC189/#task-2-array-degree
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