Perl Weekly Challenge 220.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 220.
Task 1: Common Characters
Submitted by: Mohammad S Anwar
You are given a list of words.
Write a script to return the list of common
characters (sorted alphabeticall) found in every word of the given list.
Example 1
Input: @words = ("Perl", "Rust", "Raku")
Output: ("r")
Example 2
Input: @words = ("love", "live", "leave")
Output: ("e", "l", "v")
To solve this problem, I normalize to lower case, split all words and keep their unique characters. For each character I count in how many words it appears using a hash. Finally I keep those characters that appear as many times as there are words and print the result. The code is a simple one liner.
Example 1:
perl -MList::Util=uniq -E '
for(@ARGV){$s{$_}++ for uniq split "", lc} @r=sort grep {$s{$_}==@ARGV} keys %s; say "@ARGV -> @r"
' Perl Rust Raku
Results:
Perl Rust Raku -> r
Example 2:
perl -MList::Util=uniq -E '
for(@ARGV){$s{$_}++ for uniq split "", lc} @r=sort grep {$s{$_}==@ARGV} keys %s; say "@ARGV -> @r"
' love live leave
Results:
love live leave -> e l v
The full code is similar:
1 # Perl weekly challenge 220
2 # Task 1: Common Characters
3 #
4 # See https://wlmb.github.io/2023/06/05/PWC220/#task-1-common-characters
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 W1 [W2...]
8 to return the sorted list of characters common to the words W1 W2...
9 FIN
10 use List::Util qw(uniq);
11 my %seen;
12 for(@ARGV){
13 $seen{$_}++ for uniq split "", lc
14 }
15 my $N=@ARGV;
16 my @result=sort {$a cmp $b} grep {$seen{$_}==$N} keys %seen;
17 say "@ARGV -> @result"
Example:
./ch-1.pl Perl Rust Raku
./ch-1.pl love live leave
Results:
Perl Rust Raku -> r
love live leave -> e l v
Task 2: Squareful
Submitted by: Mohammad S Anwar
You are given an array of integers, @ints.
An array is squareful if the sum of every pair of adjacent elements is a perfect square.
Write a script to find all the permutations of the given array that are squareful.
Example 1:
Input: @ints = (1, 17, 8)
Output: (1, 8, 17), (17, 8, 1)
(1, 8, 17) since 1 + 8 => 9, a perfect square and also 8 + 17 => 25 is perfect square too.
(17, 8, 1) since 17 + 8 => 25, a perfect square and also 8 + 1 => 9 is perfect square too.
Example 2:
Input: @ints = (2, 2, 2)
Output: (2, 2, 2)
There is only one permutation possible.
I list all permutations, filter out repetitions, add neighbor numbers and test their squareness. Print the permutation if it passes the test. This fits a two liner.
Example 1:
perl -MPOSIX=floor -MList::Util=all -MAlgorithm::Combinatorics=permutations -E '
say "@ARGV ->"; for(permutations[@ARGV]){@p=@$_; next if $s{"@p"}; $s{"@p"}++;
say " @p" if all {$x=sqrt($_); $x==floor $x} map {$p[$_]+$p[$_+1]} 0..@p-2;}
' 1 17 8
Results:
1 17 8 ->
1 8 17
17 8 1
Example 2:
perl -MPOSIX=floor -MList::Util=all -MAlgorithm::Combinatorics=permutations -E '
say "@ARGV ->"; for(permutations[@ARGV]){@p=@$_; next if $s{"@p"}; $s{"@p"}++;
say " @p" if all {$x=sqrt($_); $x==floor $x} map {$p[$_]+$p[$_+1]} 0..@p-2;}
' 2 2 2
Results:
2 2 2 ->
2 2 2
The full code is similar.
1 # Perl weekly challenge 220
2 # Task 2: Squareful
3 #
4 # See https://wlmb.github.io/2023/06/05/PWC220/#task-2-squareful
5 use v5.36;
6 use POSIX qw(floor);
7 use List::Util qw(all);
8 use Algorithm::Combinatorics qw(permutations);
9 die <<~"FIN" unless @ARGV>=2;
10 Usage: $0 N1 N2 [N3...]
11 to print all squarefull permutations of N1 N2...
12 FIN
13 say "@ARGV ->";
14 my %seen;
15 for(permutations[@ARGV]){
16 my @permutation=@$_;
17 next if $seen{"@permutation"};
18 $seen{"@permutation"}++;
19 say " @permutation"
20 if all {my $x=sqrt($_); $x==floor $x}
21 map {$permutation[$_]+$permutation[$_+1]}
22 0..@permutation-2;
23 }
Example:
./ch-2.pl 1 17 8
./ch-2.pl 2 2 2
Results:
1 17 8 ->
1 8 17
17 8 1
2 2 2 ->
2 2 2
Written on June 5, 2023