Perl Weekly Challenge 265.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 265.
Task 1: 33% Appearance
Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints.
Write a script to find an integer in the given array that appeared 33%
or more. If more than one found, return the smallest. If none found then
return undef.
Example 1
Input: @ints = (1,2,3,3,3,3,4,2)
Output: 3
1 appeared 1 times.
2 appeared 2 times.
3 appeared 4 times.
3 appeared 50% (>33%) in the given array.
Example 2
Input: @ints = (1,1)
Output: 1
1 appeared 2 times.
1 appeared 100% (>33%) in the given array.
Example 3
Input: @ints = (1,2,3)
Output: 1
1 appeared 1 times.
2 appeared 1 times.
3 appeared 1 times.
Since all three appeared 33.3% (>33%) in the given array.
We pick the smallest of all.
I use a hash to count
appearances. I grep the integers that appear more than a third of
the times and I use min from List::Util to choose the smallest
one. As division is not exact, I multiply
the number of appearances by three, instead of dividing the number of
integers by three. The result fits a one-liner.
Example 1:
perl -MList::Util=min -E '
$f{$_}++ for @ARGV; say "@ARGV -> ", min grep {3*$f{$_}>=@ARGV} keys %f;' 1 2 3 3 3 3 4 2
Results:
1 2 3 3 3 3 4 2 -> 3
Example 2:
perl -MList::Util=min -E '
$f{$_}++ for @ARGV; say "@ARGV -> ", min grep {3*$f{$_}>=@ARGV} keys %f;' 1 1
Results:
1 1 -> 1
Example 3:
perl -MList::Util=min -E '
$f{$_}++ for @ARGV; say "@ARGV -> ", min grep {3*$f{$_}>=@ARGV} keys %f;' 1 2 3
Results:
1 2 3 -> 1
The full code follows:
1 # Perl weekly challenge 265
2 # Task 1: 33% Appearance
3 #
4 # See https://wlmb.github.io/2024/04/16/PWC265/#task-1-33%-appearance
5 use v5.36;
6 use List::Util qw(min);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 [N2...]
9 to find the smallest of the numbers N1... that appears
10 with a frequency of at least a third.
11 FIN
12 my %frequencies;
13 $frequencies{$_}++ for @ARGV;
14 say "@ARGV -> ", (min grep {3*$frequencies{$_}>=@ARGV} keys %frequencies) // "undef";
Examples:
./ch-1.pl 1 2 3 3 3 3 4 2
./ch-1.pl 1 1
./ch-1.pl 1 2 3
./ch-1.pl 1 2 3 4
Results:
1 2 3 3 3 3 4 2 -> 3
1 1 -> 1
1 2 3 -> 1
1 2 3 4 -> undef
Task 2: Completing Word
Submitted by: Mohammad Sajid Anwar
You are given a string, $str containing alphnumeric characters and
array of strings (alphabetic characters only), @str.
Write a script to find the shortest completing word. If none found
return empty string.
A completing word is a word that contains all the letters in the given
string, ignoring space and number. If a letter appeared more than once
in the given string then it must appear the same number or more in the word.
Example 1
Input: $str = 'aBc 11c'
@str = ('accbbb', 'abc', 'abbc')
Output: 'accbbb'
The given string contains following, ignoring case and number:
a 1 times
b 1 times
c 2 times
The only string in the given array that satisfies the condition is 'accbbb'.
Example 2
Input: $str = 'Da2 abc'
@str = ('abcm', 'baacd', 'abaadc')
Output: 'baacd'
The given string contains following, ignoring case and number:
a 2 times
b 1 times
c 1 times
d 1 times
The are 2 strings in the given array that satisfies the condition:
'baacd' and 'abaadc'.
Shortest of the two is 'baacd'
Example 3
Input: $str = 'JB 007'
@str = ('jj', 'bb', 'bjb')
Output: 'bjb'
The given string contains following, ignoring case and number:
j 1 times
b 1 times
The only string in the given array that satisfies the condition is 'bjb'.
I make a function that counts letters and ignores non-letters. I grep all words by comparing
their letter counts to those of the initial string and I sort them by
length and, if necessary, alphabetically. The first word is then the
desired result. This yields a 2.5-liner
Example 1:
perl -MList::Util=all -E '
($s,@s)=@ARGV; %f=c($s); @v=sort {length $a <=> length $b || $a cmp $b} grep{my %c=c($_);
all {$c{$_} >= $f{$_}} keys %f}@s; say "str=\"$s\" arr=@s -> $v[0]"; sub c($w){my %c; $c{$_}++
for grep {/[a-z]/} split "",lc $w; %c}
' "aBc 11c" accbbb abc abbc
Results:
str="aBc 11c" arr=accbbb abc abbc -> accbbb
Example 2:
perl -MList::Util=all -E '
($s,@s)=@ARGV; %f=c($s); @v=sort {length $a <=> length $b || $a cmp $b} grep{my %c=c($_);
all {$c{$_} >= $f{$_}} keys %f}@s; say "str=\"$s\" arr=@s -> $v[0]"; sub c($w){my %c; $c{$_}++
for grep {/[a-z]/} split "",lc $w; %c}
' "Da2 abc" abcm baacd abaadc
Results:
str="Da2 abc" arr=abcm baacd abaadc -> baacd
Example 3:
perl -MList::Util=all -E '
($s,@s)=@ARGV; %f=c($s); @v=sort {length $a <=> length $b || $a cmp $b} grep{my %c=c($_);
all {$c{$_} >= $f{$_}} keys %f}@s; say "str=\"$s\" arr=@s -> $v[0]"; sub c($w){my %c; $c{$_}++
for grep {/[a-z]/} split "",lc $w; %c}
' "JB 007" jj bb bjb
Results:
str="JB 007" arr=jj bb bjb -> bjb
Another example:
perl -MList::Util=all -E '
($s,@s)=@ARGV; %f=c($s); @v=sort {length $a <=> length $b || $a cmp $b} grep{my %c=c($_);
all {$c{$_} >= $f{$_}} keys %f}@s; say "str=\"$s\" arr=@s -> $v[0]"; sub c($w){my %c; $c{$_}++
for grep {/[a-z]/} split "",lc $w; %c}
' "abc" abc bca cab
Results:
str="abc" arr=abc bca cab -> abc
The full code follows. I added some tests and print “” if there is no completing string.
1 # Perl weekly challenge 265
2 # Task 2: Completing Word
3 #
4 # See https://wlmb.github.io/2024/04/16/PWC265/#task-2-completing-word
5 use v5.36;
6 use List::Util qw(all);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S [W1...]
9 to find the shortest completing word of string S among the words W1, W2...
10 FIN
11 my ($string, @words)=@ARGV;
12 my %frequencies = count_letters($string);
13 my @ordered= sort {length $a <=> length $b || $a cmp $b}
14 grep {
15 my %c=count_letters($_);
16 all {
17 ($c{$_}//0) >= $frequencies{$_}
18 }
19 keys %frequencies
20 } @words;
21 say "str=\"$string\" words=@words -> ", $ordered[0] // '""';
22 sub count_letters($word){
23 my %count;
24 $count{$_}++ for grep {/[a-z]/} split "",lc $word;
25 %count
26 }
Examples:
./ch-2.pl "aBc 11c" accbbb abc abbc
./ch-2.pl "Da2 abc" abcm baacd abaadc
./ch-2.pl "JB 007" jj bb bjb
./ch-2.pl "abc" abc bca cab
./ch-2.pl "abc" ab bc ca
Results:
str="aBc 11c" words=accbbb abc abbc -> accbbb
str="Da2 abc" words=abcm baacd abaadc -> baacd
str="JB 007" words=jj bb bjb -> bjb
str="abc" words=abc bca cab -> abc
str="abc" words=ab bc ca -> ""
Written on April 16, 2024