Perl Weekly Challenge 221.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 221.
Task 1: Good Strings
Submitted by: Mohammad S Anwar
You are given a list of @words and a string $chars.
A string is good if it can be formed by characters from $chars, each character
can be used only once.
Write a script to return the sum of lengths of all good strings in words.
Example 1
Input: @words = ("cat", "bt", "hat", "tree")
$chars = "atach"
Output: 6
The good strings that can be formed are "cat" and "hat" so the answer is 3 + 3 = 6.
Example 2
Input: @words = ("hello", "world", "challenge")
$chars = "welldonehopper"
Output: 10
The strings that can be formed are "hello" and "world" so the answer is 5 + 5 = 10.
The example shows that repeated chars may be used as many times as
they are repeated. The task then is to compare the number of times
each string appears in each word to the number of times it appears in
the chars and use the result to filter good strings. The result fits
a two-liner.
Example 1:
perl -MList::Util=all -E '
($c,@w)=@ARGV; $c{$_}++ for split "", $c; @r=grep {my %w; $w{$_}++ for split ""; all {$w{$_}<=$c{$_}}
keys %w} @w; say("chars: $c, words: @w -> good strings: @r -> length: ", length join "", @r)
' atach cat bt hat tree
Results:
chars: atach, words: cat bt hat tree -> good strings: cat hat -> length: 6
Example 2:
perl -MList::Util=all -E '
($c,@w)=@ARGV; $c{$_}++ for split "", $c; @r=grep {my %w; $w{$_}++ for split ""; all {$w{$_}<=$c{$_}}
keys %w} @w; say("chars: $c, words: @w -> good strings: @r -> length: ", length join "", @r)
' welldonehopper hello world challenge
Results:
chars: welldonehopper, words: hello world challenge -> good strings: hello world -> length: 10
The full code is:
1 # Perl weekly challenge 221
2 # Task 1: Good Strings
3 #
4 # See https://wlmb.github.io/2023/06/12/PWC221/#task-1-good-strings
5 use v5.36;
6 use List::Util qw(all);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 C W1 [W2...]
9 to find the total length of the set of words {Wn} than are formed by
10 the characters in C
11 FIN
12 my ($chars, @words)=@ARGV;
13 my %char_count;
14 $char_count{$_}++ for split "", $chars;
15 my @results=grep {
16 my %word_char_count;
17 $word_char_count{$_}++ for split "";
18 all {$word_char_count{$_}<=$char_count {$_}} keys %word_char_count
19 } @words;
20 say("chars: $chars, words: @words -> good strings: @results -> length: ",
21 length join "", @results)
Examples:
./ch-1.pl atach cat bt hat tree
./ch-1.pl welldonehopper hello world challenge
Results:
chars: atach, words: cat bt hat tree -> good strings: cat hat -> length: 6
chars: welldonehopper, words: hello world challenge -> good strings: hello world -> length: 10
Task 2: Arithmetic Subsequence
Submitted by: Mohammad S Anwar
You are given an array of integers, @ints.
Write a script to find the length of the longest Arithmetic Subsequence
in the given array.
A subsequence is an array that can be derived from another array by deleting
some or none elements without changing the order of the remaining elements.
A subsquence is arithmetic if ints[i + 1] - ints[i] are all the same value
(for 0 <= i < ints.length - 1).
Example 1:
Input: @ints = (9, 4, 7, 2, 10)
Output: 3
The longest Arithmetic Subsequence (4, 7, 10) can be derived by deleting 9 and 2.
Example 2:
Input: @ints = (3, 6, 9, 12)
Output: 4
No need to remove any elements, it is already an Arithmetic Subsequence.
Example 3:
Input: @ints = (20, 1, 15, 3, 10, 5, 8)
Output: 4
The longest Arithmetic Subsequence (20, 15, 10, 5) can be derived by deleting
1, 3 and 8.
To solve this problem I make two subroutines. One tests all arithmetic subsequences starting from the first element of a subarray and chooses the longest one. The subarrays are obtained by choping sequentially the first elements of the given array. The other subroutine searches for the second element of an arithmetic sequence given a subarray and a distance, and recurses from that element onwards. This allows a three-liner solution:
Example 1:
perl -MList::Util=max,first -E '
@s=@ARGV; say "@s -> ", max map {u(@s[$_..@s-1])} 0..@s-1; sub u(@s){return 0+@s unless @s>1;
return 1+max map {t($s[$_]-$s[0], @s[$_..@s-1])} 1..@s-1;} sub t($v, @s){$i=first
{$s[$_]==$s[0]+$v} 1..@s-1; return 1 unless defined $i; return 1+t($v, @s[$i..@s-1]);}
' 9 4 7 2 10
Results:
9 4 7 2 10 -> 3
I’ll explain with more details in the full code.
Example 2:
perl -MList::Util=max,first -E '
@s=@ARGV; say "@s -> ", max map {u(@s[$_..@s-1])} 0..@s-1; sub u(@s){return 0+@s unless @s>1;
return 1+max map {t($s[$_]-$s[0], @s[$_..@s-1])} 1..@s-1;} sub t($v, @s){$i=first
{$s[$_]==$s[0]+$v} 1..@s-1; return 1 unless defined $i; return 1+t($v, @s[$i..@s-1]);}
' 3 6 9 12
Results:
3 6 9 12 -> 4
Example 3:
perl -MList::Util=max,first -E '
@s=@ARGV; say "@s -> ", max map {u(@s[$_..@s-1])} 0..@s-1; sub u(@s){return 0+@s unless @s>1;
return 1+max map {t($s[$_]-$s[0], @s[$_..@s-1])} 1..@s-1;} sub t($v, @s){$i=first
{$s[$_]==$s[0]+$v} 1..@s-1; return 1 unless defined $i; return 1+t($v, @s[$i..@s-1]);}
' 20 1 15 3 10 5 8
Results:
20 1 15 3 10 5 8 -> 4
The full code has some more explanations:
1 # Perl weekly challenge 221
2 # Task 2: Arithmetic Subsequence
3 #
4 # See https://wlmb.github.io/2023/06/12/PWC221/#task-2-arithmetic-subsequence
5 use v5.36;
6 use List::Util qw(max first);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 [N2...]
9 to find the longest arithmetic subsequence of the integers N1 N2...
10 FIN
11 my @set=@ARGV;
12 # Search longest subsequence, remove leading element and repeat. Keep max.
13 say "@set -> ", max map {test(@set[$_..@set-1])} 0..@set-1;
14
15 sub test(@subset){
16 return 0+@subset unless @subset>1; # 0 or 1 for empty or one element subsets
17 return 1+max map {rest($subset[$_]-$subset[0], @subset[$_..@subset-1])} 1..@subset-1;
18 }
19
20 sub rest($val, @subset){
21 # find index of next (the second) element of arithmetic subsequence
22 # starting at the first element $subset[0] and separated by value $val
23 my $i=first {$subset[$_]==$subset[0]+$val} 1..@subset-1;
24 return 1 unless defined $i; # none found? Only the first element is in sequence
25 return 1+rest($val, @subset[$i..@subset-1]); # recurse starting from found value
26 }
Examples:
./ch-2.pl 9 4 7 2 10
./ch-2.pl 3 6 9 12
./ch-2.pl 20 1 15 3 10 5 8
Results:
9 4 7 2 10 -> 3
3 6 9 12 -> 4
20 1 15 3 10 5 8 -> 4
Written on June 12, 2023