aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLuis Mochan <mochan@fis.unam.mx>2023-06-05 10:44:42 -0600
committerLuis Mochan <mochan@fis.unam.mx>2023-06-05 10:44:42 -0600
commitcb5c06766814178c3dcce8a8300c05bc493fa957 (patch)
treebb8985bf849885d409e12079d1de04a959282a26
parent401be1861472af6d62bbdeb0fe65f6ced1ca8f31 (diff)
downloadperlweeklychallenge-club-cb5c06766814178c3dcce8a8300c05bc493fa957.tar.gz
perlweeklychallenge-club-cb5c06766814178c3dcce8a8300c05bc493fa957.tar.bz2
perlweeklychallenge-club-cb5c06766814178c3dcce8a8300c05bc493fa957.zip
Solve PWC220
-rw-r--r--challenge-220/wlmb/blog.txt2
-rwxr-xr-xchallenge-220/wlmb/perl/ch-1.pl18
-rwxr-xr-xchallenge-220/wlmb/perl/ch-2.pl24
3 files changed, 44 insertions, 0 deletions
diff --git a/challenge-220/wlmb/blog.txt b/challenge-220/wlmb/blog.txt
new file mode 100644
index 0000000000..fdd7dff769
--- /dev/null
+++ b/challenge-220/wlmb/blog.txt
@@ -0,0 +1,2 @@
+https://wlmb.github.io/2023/06/05/PWC220/
+
diff --git a/challenge-220/wlmb/perl/ch-1.pl b/challenge-220/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..28a2656fc7
--- /dev/null
+++ b/challenge-220/wlmb/perl/ch-1.pl
@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 220
+# Task 1: Common Characters
+#
+# See https://wlmb.github.io/2023/06/05/PWC220/#task-1-common-characters
+use v5.36;
+die <<~"FIN" unless @ARGV;
+ Usage: $0 W1 [W2...]
+ to return the sorted list of characters common to the words W1 W2...
+ FIN
+use List::Util qw(uniq);
+my %seen;
+for(@ARGV){
+ $seen{$_}++ for uniq split "", lc
+}
+my $N=@ARGV;
+my @result=sort {$a cmp $b} grep {$seen{$_}==$N} keys %seen;
+say "@ARGV -> @result"
diff --git a/challenge-220/wlmb/perl/ch-2.pl b/challenge-220/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..8e14f15ff2
--- /dev/null
+++ b/challenge-220/wlmb/perl/ch-2.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 220
+# Task 2: Squareful
+#
+# See https://wlmb.github.io/2023/06/05/PWC220/#task-2-squareful
+use v5.36;
+use POSIX qw(floor);
+use List::Util qw(all);
+use Algorithm::Combinatorics qw(permutations);
+die <<~"FIN" unless @ARGV>=2;
+ Usage: $0 N1 N2 [N3...]
+ to print all squarefull permutations of N1 N2...
+ FIN
+say "@ARGV ->";
+my %seen;
+for(permutations[@ARGV]){
+ my @permutation=@$_;
+ next if $seen{"@permutation"};
+ $seen{"@permutation"}++;
+ say " @permutation"
+ if all {my $x=sqrt($_); $x==floor $x}
+ map {$permutation[$_]+$permutation[$_+1]}
+ 0..@permutation-2;
+}