Merge pull request #8209 from boblied/w220

Week 220 solutions

3 files changed, 132 insertions, 3 deletions

diff --git a/challenge-220/bob-lied/README b/challenge-220/bob-lied/README
index 3900c8b0ad..f428433412 100644
--- a/challenge-220/bob-lied/README
+++ b/challenge-220/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 217 by Bob Lied
+Solutions to weekly challenge 220 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-217/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-217/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-220/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-220/bob-lied
diff --git a/challenge-220/bob-lied/perl/ch-1.pl b/challenge-220/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..bae267a6cd
--- /dev/null
+++ b/challenge-220/bob-lied/perl/ch-1.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 220 Task 1 Common Characters 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a list of words.
+# Write a script to return the list of common characters (sorted
+# alphabetically) 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")
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw(all uniq);
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub commonCharacters($list)
+{
+    my @lcList = map { lc } @$list;
+    my $firstWord = shift @lcList;
+    my @possible = uniq sort split //, $firstWord;
+
+    sub isEverywhere($c, $words) { all {index($_, $c) >= 0  } @$words };
+
+    my @common = grep { isEverywhere($_, \@lcList) } @possible;
+
+    return \@common;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is(commonCharacters( [ qw(Perl Rust Raku) ] ), [ qw(r) ], "Example 1");
+    is(commonCharacters( [ qw(love live leave)] ), [ qw(e l v) ], "Example 1");
+
+    done_testing;
+}
diff --git a/challenge-220/bob-lied/perl/ch-2.pl b/challenge-220/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..caca971249
--- /dev/null
+++ b/challenge-220/bob-lied/perl/ch-2.pl
@@ -0,0 +1,80 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 220 Task 2 Squareful 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# 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, and also 8 + 17 => 25 are perfect squares.
+#   (17, 8, 1) since 17 + 8 = 25 and 8 + 1 = 9 are squares.
+# Example 2: Input: @ints = (2, 2, 2)
+#           Output: (2, 2, 2)
+#   Only one permutation with 2+2=4 and 2+2=4 (two different pairs).
+#=============================================================================
+
+use v5.36;
+
+use Algorithm::Permute;
+use List::Util qw(all);
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub isSquare($n)
+{
+    my $r = sqrt($n);
+    return $r == int($r);
+}
+
+sub pairSum($list)
+{
+    return map { $list->[$_-1] + $list->[$_] } 1 .. ($list->$#*);
+}
+
+sub uniqify($arrOfArr)
+{
+    my %presence;
+    my @unique;
+    for my $list ( $arrOfArr->@* )
+    {
+        my $hash = join("|", $list->@*);
+        push @unique, $list unless exists $presence{$hash};
+        $presence{$hash} = 1;
+    }
+    return \@unique;
+}
+
+
+sub squareful(@ints)
+{
+    my @isSquareful;
+    Algorithm::Permute::permute {
+        push @isSquareful, [ @ints] if all { isSquare($_) } pairSum(\@ints)
+    } @ints;
+    return uniqify(\@isSquareful);
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( isSquare(6), '', "isSquare no");
+    is( isSquare(16), 1, "isSquare yes");
+
+    is( [ pairSum([1,2,3,9]) ], [3,5,12], "pairSum");
+
+    is(squareful(1, 17, 8), [ [1,8,17], [17,8,1] ], "Example 1");
+    is(squareful(2,  2, 2), [ [2,2,2]            ], "Example 2");
+
+    done_testing;
+}