# Perl Weekly Challenge 245.

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

``````Submitted by: Mohammad S Anwar
You are given two array of languages and its popularity.

Write a script to sort the language based on popularity.

Example 1
Input: @lang = ('perl', 'c', 'python')
@popularity = (2, 1, 3)
Output: ('c', 'perl', 'python')
Example 2
Input: @lang = ('c++', 'haskell', 'java')
@popularity = (1, 3, 2)
``````

The problem may be solved by simply using `sort` on the indices of both arrays. I assume both arrays are input as space separated strings in @ARGV. This yields a 2-liner. Example 1:

``````perl -E '
\$l[\$_]=[split " ", \$ARGV[\$_]] for 0,1; @s=map {\$l[0][\$_]} sort {\$l[1][\$a]<=>\$l[1][\$b]}
0..@{\$l[0]}-1; say "languages: @{\$l[0]}\npopularity: @{\$l[1]}\nsorted: @s";
' "perl c python" "2 1 3"
``````

Results:

``````languages: perl c python
popularity: 2 1 3
sorted: c perl python
``````

Example 2:

``````perl -E '
\$l[\$_]=[split " ", \$ARGV[\$_]] for 0,1; @s=map {\$l[0][\$_]} sort {\$l[1][\$a]<=>\$l[1][\$b]} 0..@{\$l[0]}-1;
say "languages: @{\$l[0]}\npopularity: @{\$l[1]}\nsorted: @s";
' "c++ haskell java" "1 3 2"
``````

Results:

``````languages: c++ haskell java
popularity: 1 3 2
``````

I can also do a Schwartzian transform for sorting:

``````perl -MList::MoreUtils=pairwise -E '
\$l[\$_]=[split " ", \$ARGV[\$_]]for 0,1;say "languages: @{\$l[0]}\npopularity: @{\$l[1]}\nsorted: ",
join " ", map {\$_->[0]} sort {\$a->[1] <=> \$b->[1]} pairwise {[\$a,\$b]} @{\$l[0]}, @{\$l[1]};
' "perl c python" "2 1 3"
``````

Results:

``````languages: perl c python
popularity: 2 1 3
sorted: c perl python
``````

However, in this simple case the resulting code is not simpler.

The full code corresponds to the first solution

`````` 1  # Perl weekly challenge 245
2  # Task 1:  Sort Language
3  #
5  use v5.36;
6  die <<~"FIN" unless @ARGV && @ARGV%2==0;
7      Usage: \$0 L1 P1 [L2 P2...]
8      to sort the space separated list of languages Ln
9      according to their popularity Pn
10      FIN
11  while(@ARGV){
12      my @language=split " ", shift;
13      my @popularity=split " ", shift;
14      warn("Number of elements should coincide: languages: @language vs. popularities @popularity\n"),
15  	next unless @language==@popularity;
16      my @sorted=map {\$language[\$_]} sort {\$popularity[\$a]<=>\$popularity[\$b]} 0..@language-1;
17      say "languages: @language\npopularities: @popularity\nsorted: @sorted\n";
18  }
``````

Example:

``````./ch-1.pl "perl c python" "2 1 3" "c++ haskell java" "1 3 2"
``````

Results:

``````languages: perl c python
popularities: 2 1 3
sorted: c perl python

popularities: 1 3 2
``````

# Task 2: Largest of Three

``````Submitted by: Mohammad S Anwar
You are given an array of integers >= 0.

Write a script to return the largest number formed by concatenating some
of the given integers in any order which is also multiple of 3.
Return -1 if none found.

Example 1
Input: @ints = (8, 1, 9)
Output: 981

981 % 3 == 0
Example 2
Input: @ints = (8, 6, 7, 1, 0)
Output: 8760
Example 3
Input: @ints = (1)
Output: -1
``````

As 10 is congruent to 1 modulo 3, a number is divisible by three if the sum of its decimal digits is divisible by three. Thus, rearrangement of the digits does not affect divisibility by three. Call N=NK … N2 N1 N0 the concatenation of all sorted inputs. Choosing N0 N1<=N1 N0, N1 N2<=N2 N1… then N would be the largest number that can be obtained by concatenating the inputs (I am grateful to `choroba` for pointing out a mistake in a pervious solution). Set r=N%3. If r==0 we are done. If r==1, then we can remove from N the smallest Nk such that Nk%3==1, or the two smallest Nl and Nm such that Nl%3==Nm%3==2, as 2+2 is congruent to 1 modulo 3. Similarly, if r==2, then we can remove from N the smallest Nk such that Nk%3==2, or remove the smallest Nl and Nm such that Nl%3=Nm%3==1. If necessary, we can choose between removing the single number Nk or the two numbers Nl and Nm by comparing Nk and the concatenation of Nl and Nm (assuming l>m) and choosing the smallest. The resulting number would then be the largest number that can be formed by concatenating integers from a list and that is divisible by three. The code seems too complex for a few-liner, so I first jump to the full code, and then the compact solution:

`````` 1  # Perl weekly challenge 245
2  # Task 2:  Largest of Three
3  #
5  use v5.36;
6  use List::Util qw(all);
7  die <<~"FIN" unless @ARGV;
8      Usage: \$0 N1 [N2...]
9      to find the largest concatenation of numbers N_i which yield a
10      multiple of 3.
11      FIN
12  die "Only non-negative numbers allowed" unless all {/\d+/} @ARGV;
13  my \$index=0;
14  my \$total;
15  my @one;
16  my @two;
17  my @sorted= sort{"\$a\$b"<=>"\$b\$a"}@ARGV; # increasing order
18  for(@sorted){
19      my \$residue=\$_%3;
20      push @one, \$index  if \$residue==1;
21      push @two, \$index  if \$residue==2;
22      \$total+=\$residue;
23      ++\$index;
24  }
25  \$total%=3;
26  my @candidates; # if neccesary to remove numbers
27  if(\$total==1){
28      # remove the smallest number that leaves a residue one
29      push @candidates, [\$one[0]] if(@one);
30      # remove the two smallest numbers that leaves a residue two
31      push @candidates, [@two[1,0]] if(@two>=2);
32  }
33  if(\$total==2){
34      # remove the two smallest numbers that leaves a residue one
35      push @candidates, [@one[1,0]] if(@one>=2);
36      # or the smallest numbers that leaves a residue two
37      push @candidates, [\$two[0]] if(@two);
38  }
39  if(@candidates){ # find smallest candidates
40      my @to_remove=map {join "", @sorted[@\$_]} @candidates;
41      my \$index_to_remove=@candidates == 2 && \$to_remove[1]<\$to_remove[0]?1:0;
42      splice @sorted, \$_, 1 for @{\$candidates[\$index_to_remove]}; # remove one or two numbers
43  }
44  my \$result=join "", reverse @sorted;
45  \$result=-1 if \$result eq ""; # removed all
46  \$result=0 if \$result==0; # 0000...=0 is divisible;
47  say "@ARGV -> \$result";
``````

Examples:

``````./ch-2.pl 8 1 9
./ch-2.pl 8 6 7 1 0
./ch-2.pl 1
./ch-2.pl 0 0 0
``````

Results:

``````8 1 9 -> 981
8 6 7 1 0 -> 8760
1 -> -1
0 0 0 -> 0
8 85 0 -> 8850
``````

Examples by E-Choroba:

``````./ch-2.pl 4 8 911 # 9114
./ch-2.pl 8 85 0  # 8850
./ch-2.pl 8 89 2  # 8982
./ch-2.pl 8 76 0  # 8760
./ch-2.pl 8 94 0  # 9480
``````

Results:

``````4 8 911 -> 9114
8 85 0 -> 8850
8 89 2 -> 8982
8 76 0 -> 8760
8 94 0 -> 9480
``````

After a few simplifications, I could compact the code into a 3.5-liner.

Examples:

``````perl -E '
\$i=0;@s=sort{"\$a\$b"<=>"\$b\$a"}@ARGV;for(@s){\$t+=(\$r=\$_%3);push @{\$r[\$r]},\$i++;}\$t%=3;if(\$t){
push @c, [\$r[\$t][0]] if \$r[\$t];push @c, [@{\$r[3-\$t]}[1,0]] if \$r[3-\$t];}if(@c){
@t=map {join "", @s[@\$_]} @c;\$i=@c==2&&\$t[1]<\$t[0]?1:0;splice @s, \$_, 1 for @{\$c[\$i]};}
\$r=join "", reverse @s;\$r=-1 if \$r eq "";say "@ARGV -> \$r";
' 8 1 9
perl -E '
\$i=0;@s=sort{"\$a\$b"<=>"\$b\$a"}@ARGV;for(@s){\$t+=(\$r=\$_%3);push @{\$r[\$r]},\$i++;}\$t%=3;if(\$t){
push @c, [\$r[\$t][0]] if \$r[\$t];push @c, [@{\$r[3-\$t]}[1,0]] if \$r[3-\$t];}if(@c){
@t=map {join "", @s[@\$_]} @c;\$i=@c==2&&\$t[1]<\$t[0]?1:0;splice @s, \$_, 1 for @{\$c[\$i]};}
\$r=join "", reverse @s;\$r=-1 if \$r eq "";say "@ARGV -> \$r";
' 8 6 7 1 0
perl -E '
\$i=0;@s=sort{"\$a\$b"<=>"\$b\$a"}@ARGV;for(@s){\$t+=(\$r=\$_%3);push @{\$r[\$r]},\$i++;}\$t%=3;if(\$t){
push @c, [\$r[\$t][0]] if \$r[\$t];push @c, [@{\$r[3-\$t]}[1,0]] if \$r[3-\$t];}if(@c){
@t=map {join "", @s[@\$_]} @c;\$i=@c==2&&\$t[1]<\$t[0]?1:0;splice @s, \$_, 1 for @{\$c[\$i]};}
\$r=join "", reverse @s;\$r=-1 if \$r eq "";say "@ARGV -> \$r";
' 1
perl -E '
\$i=0;@s=sort{"\$a\$b"<=>"\$b\$a"}@ARGV;for(@s){\$t+=(\$r=\$_%3);push @{\$r[\$r]},\$i++;}\$t%=3;if(\$t){
push @c, [\$r[\$t][0]] if \$r[\$t];push @c, [@{\$r[3-\$t]}[1,0]] if \$r[3-\$t];}if(@c){
@t=map {join "", @s[@\$_]} @c;\$i=@c==2&&\$t[1]<\$t[0]?1:0;splice @s, \$_, 1 for @{\$c[\$i]};}
\$r=join "", reverse @s;\$r=-1 if \$r eq "";say "@ARGV -> \$r";
' 8 85 0
``````

``````perl -E '
\$i=0;@s=sort{"\$a\$b"<=>"\$b\$a"}@ARGV;for(@s){\$t+=(\$r=\$_%3);push @{\$r[\$r]},\$i++;}\$t%=3;if(\$t){
push @c, [\$r[\$t][0]] if \$r[\$t];push @c, [@{\$r[3-\$t]}[1,0]] if \$r[3-\$t];}if(@c){
@t=map {join "", @s[@\$_]} @c;\$i=@c==2&&\$t[1]<\$t[0]?1:0;splice @s, \$_, 1 for @{\$c[\$i]};}
\$r=join "", reverse @s;\$r=-1 if \$r eq "";say "@ARGV -> \$r";
' 4 8 911 # 9114
perl -E '
\$i=0;@s=sort{"\$a\$b"<=>"\$b\$a"}@ARGV;for(@s){\$t+=(\$r=\$_%3);push @{\$r[\$r]},\$i++;}\$t%=3;if(\$t){
push @c, [\$r[\$t][0]] if \$r[\$t];push @c, [@{\$r[3-\$t]}[1,0]] if \$r[3-\$t];}if(@c){
@t=map {join "", @s[@\$_]} @c;\$i=@c==2&&\$t[1]<\$t[0]?1:0;splice @s, \$_, 1 for @{\$c[\$i]};}
\$r=join "", reverse @s;\$r=-1 if \$r eq "";say "@ARGV -> \$r";
' 8 85 0  # 8850
perl -E '
\$i=0;@s=sort{"\$a\$b"<=>"\$b\$a"}@ARGV;for(@s){\$t+=(\$r=\$_%3);push @{\$r[\$r]},\$i++;}\$t%=3;if(\$t){
push @c, [\$r[\$t][0]] if \$r[\$t];push @c, [@{\$r[3-\$t]}[1,0]] if \$r[3-\$t];}if(@c){
@t=map {join "", @s[@\$_]} @c;\$i=@c==2&&\$t[1]<\$t[0]?1:0;splice @s, \$_, 1 for @{\$c[\$i]};}
\$r=join "", reverse @s;\$r=-1 if \$r eq "";say "@ARGV -> \$r";
' 8 89 2  # 8982
perl -E '
\$i=0;@s=sort{"\$a\$b"<=>"\$b\$a"}@ARGV;for(@s){\$t+=(\$r=\$_%3);push @{\$r[\$r]},\$i++;}\$t%=3;if(\$t){
push @c, [\$r[\$t][0]] if \$r[\$t];push @c, [@{\$r[3-\$t]}[1,0]] if \$r[3-\$t];}if(@c){
@t=map {join "", @s[@\$_]} @c;\$i=@c==2&&\$t[1]<\$t[0]?1:0;splice @s, \$_, 1 for @{\$c[\$i]};}
\$r=join "", reverse @s;\$r=-1 if \$r eq "";say "@ARGV -> \$r";
' 8 76 0  # 8760
perl -E '
\$i=0;@s=sort{"\$a\$b"<=>"\$b\$a"}@ARGV;for(@s){\$t+=(\$r=\$_%3);push @{\$r[\$r]},\$i++;}\$t%=3;if(\$t){
push @c, [\$r[\$t][0]] if \$r[\$t];push @c, [@{\$r[3-\$t]}[1,0]] if \$r[3-\$t];}if(@c){
@t=map {join "", @s[@\$_]} @c;\$i=@c==2&&\$t[1]<\$t[0]?1:0;splice @s, \$_, 1 for @{\$c[\$i]};}
\$r=join "", reverse @s;\$r=-1 if \$r eq "";say "@ARGV -> \$r";
' 8 94 0  # 9480
``````

Results:

``````4 8 911 -> 9114
8 85 0 -> 8850
8 89 2 -> 8982
8 76 0 -> 8760
8 94 0 -> 9480
``````
Written on November 27, 2023