Perl Weekly Challenge 284.

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

Task 1: Lucky Integer

Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints.

Write a script to find the lucky integer if found otherwise return -1. If there are
more than one then return the largest.

A lucky integer is an integer that has a frequency in the array equal to its value.

Example 1
Input: @ints = (2, 2, 3, 4)
Output: 2
Example 2
Input: @ints = (1, 2, 2, 3, 3, 3)
Output: 3
Example 3
Input: @ints = (1, 1, 1, 3)
Output: -1

I can make a hash of frequencies, use it to grep lucky numbers and choose the largest if it exists, or -1. The result fits a one-liner.

Example 1:

perl -MList::Util=max -E '
$f{$_}++ for @ARGV; say "@ARGV -> ", (max grep {$_==$f{$_}} keys %f)//-1
' 2 2 3 4

Results:

2 2 3 4 -> 2

Example 2:

perl -MList::Util=max -E '
$f{$_}++ for @ARGV; say "@ARGV -> ", (max grep {$_==$f{$_}} keys %f)//-1
' 1 2 2 3 3 3

Results:

1 2 2 3 3 3 -> 3

Example 3:

perl -MList::Util=max -E '
$f{$_}++ for @ARGV; say "@ARGV -> ", (max grep {$_==$f{$_}} keys %f)//-1
' 1 1 1 3

Results:

1 1 1 3 -> -1

The full code follows:

 1  # Perl weekly challenge 283
 2  # Task 1:  Lucky Integer
 3  #
 4  # See https://wlmb.github.io/2024/08/26/PWC283/#task-1-lucky-integer
 5  use v5.36;
 6  use List::Util qw(max);
 7  die <<~"FIN" unless @ARGV;
 8      Usage: $0 N1 N2...
 9      to find the largest lucky number among N1 N2...
10      FIN
11  my %frequency_of;
12  $frequency_of{$_}++ for @ARGV;
13  say "@ARGV -> ", (max grep {$_==$frequency_of{$_}} keys %frequency_of)//-1;

Example:

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

Results:

2 2 3 4 -> 2
1 2 2 3 3 3 -> 3
1 1 1 3 -> -1

Task 2: Relative Sort

Submitted by: Mohammad Sajid Anwar
You are given two list of integers, @list1 and @list2. The elements in
the @list2 are distinct and also in the @list1.

Write a script to sort the elements in the @list1 such that the relative
order of items in @list1 is same as in the @list2. Elements that is missing
in @list2 should be placed at the end of @list1 in ascending order.

Example 1
Input: @list1 = (2, 3, 9, 3, 1, 4, 6, 7, 2, 8, 5)
       @list2 = (2, 1, 4, 3, 5, 6)
Ouput: (2, 2, 1, 4, 3, 3, 5, 6, 7, 8, 9)
Example 2
Input: @list1 = (3, 3, 4, 6, 2, 4, 2, 1, 3)
       @list2 = (1, 3, 2)
Ouput: (1, 3, 3, 3, 2, 2, 4, 4, 6)
Example 3
Input: @list1 = (3, 0, 5, 0, 2, 1, 4, 1, 1)
       @list2 = (1, 0, 3, 2)
Ouput: (1, 1, 1, 0, 0, 3, 2, 4, 5)

I can make a hash with the rank of the numbers in the first list. Then, I just sort the elements of the following list using the criteria:

  1. Defined ranks go before undefined ranks.
  2. Use rank.
  3. Use value.

I assume the numbers are given in two space separated strings. The result fits a two-liner:

Example 1:

perl -E '
($x,$y)=map {[split " ", $_]}@ARGV;@y=@$y;$r{$y[$_]}=$_ for 0..@y-1;@s=sort{
defined $r{$b}<=>defined $r{$a}||$r{$a}<=>$r{$b}||$a<=>$b} @x=@$x;say "@x; @y -> @s"
' "2 3 9 3 1 4 6 7 2 8" "2 1 4 3 5 6"

Results:

2 3 9 3 1 4 6 7 2 8; 2 1 4 3 5 6 -> 2 2 1 4 3 3 6 7 8 9

Example 2:

perl -E '
($x,$y)=map {[split " ", $_]}@ARGV;@y=@$y;$r{$y[$_]}=$_ for 0..@y-1;@s=sort{
defined $r{$b}<=>defined $r{$a}||$r{$a}<=>$r{$b}||$a<=>$b} @x=@$x;say "@x; @y -> @s"
' "3 3 4 6 2 4 2 1 3" "1 3 2"

Results:

3 3 4 6 2 4 2 1 3; 1 3 2 -> 1 3 3 3 2 2 4 4 6

Example 3

perl -E '
($x,$y)=map {[split " ", $_]}@ARGV;@y=@$y;$r{$y[$_]}=$_ for 0..@y-1;@s=sort{
defined $r{$b}<=>defined $r{$a}||$r{$a}<=>$r{$b}||$a<=>$b} @x=@$x;say "@x; @y -> @s"
' "3 0 5 0 2 1 4 1 1" "1 0 3 2"

Results:

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

The corresponding full code is:

 1  # Perl weekly challenge 283
 2  # Task 2:  Relative Sort
 3  #
 4  # See https://wlmb.github.io/2024/08/26/PWC283/#task-2-relative-sort
 5  use v5.36;
 6  use experimental qw(for_list);
 7  use Scalar::Util qw(looks_like_number);
 8  use List::Util qw(all);
 9  die <<~"FIN" unless @ARGV && @ARGV%2==0;
10      Usage: $0 L11 L12 L21 L22...
11      to sort the elements of the list Li1 using the ranks given by Li2.
12      Lij is a string containing a list of string separated numbers.
13      FIN
14  for my ($list, $order)(@ARGV){
15      my @list=split " ", $list;
16      my @order=split " ", $order;
17      warn("Expected only numbers: $list; $order"), next
18          unless all {looks_like_number($_)} (@list, @order);
19      my %rank_of;
20      $rank_of{$order[$_]}=$_ for 0..@order-1;
21      my  %is_ranked;
22      $is_ranked{$_}=defined $rank_of{$_}?1:0 for @list;
23      my @sorted;
24      @sorted= sort {
25           ($is_ranked{$b} <=> $is_ranked{$a})
26           || ($rank_of{$a}||0) <=> ($rank_of{$b}||0)
27           || $a <=> $b
28      } @list;
29      say "@list; @order -> @sorted";
30  }

Example:

./ch-2.pl '2 3 9 3 1 4 6 7 2 8' '2 1 4 3 5 6' \
          '3 3 4 6 2 4 2 1 3' '1 3 2' \
          '3 0 5 0 2 1 4 1 1' '1 0 3 2'

Results:

2 3 9 3 1 4 6 7 2 8; 2 1 4 3 5 6 -> 2 2 1 4 3 3 6 7 8 9
3 3 4 6 2 4 2 1 3; 1 3 2 -> 1 3 3 3 2 2 4 4 6
3 0 5 0 2 1 4 1 1; 1 0 3 2 -> 1 1 1 0 0 3 2 4 5
Written on August 26, 2024