Merge pull request #3929 from polettix/polettix/pwc109

Add polettix's solution to challenge-109

4 files changed, 74 insertions, 0 deletions

diff --git a/challenge-109/polettix/blog.txt b/challenge-109/polettix/blog.txt
new file mode 100644
index 0000000000..ccdd4a9271
--- /dev/null
+++ b/challenge-109/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/04/21/pwc109-chowla-numbers/
diff --git a/challenge-109/polettix/blog1.txt b/challenge-109/polettix/blog1.txt
new file mode 100644
index 0000000000..8a7a023f02
--- /dev/null
+++ b/challenge-109/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/04/22/pwc109-four-squares-puzzle/
diff --git a/challenge-109/polettix/perl/ch-1.pl b/challenge-109/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..214eacc43c
--- /dev/null
+++ b/challenge-109/polettix/perl/ch-1.pl
@@ -0,0 +1,12 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+use List::Util 'sum';
+
+sub gcd { my ($A, $B) = @_; ($A, $B) = ($B % $A, $A) while $A; return $B }
+
+sub chowla_number ($n) { sum(grep { gcd($n, $_) == $_ } 2 .. $n - 1) // 0 }
+
+say join ', ', map { chowla_number($_) } 1 .. 20;
diff --git a/challenge-109/polettix/perl/ch-2.pl b/challenge-109/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..0319d1eb58
--- /dev/null
+++ b/challenge-109/polettix/perl/ch-2.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+use List::Util 'shuffle';
+
+sub four_squares_puzzle (@values) {
+   my $it = permutations_iterator(items => [@values]);
+   while (my @S = $it->()) {
+      my $sum = $S[0] + $S[1];
+      next if $sum != $S[1] + $S[2] + $S[3];
+      next if $sum != $S[3] + $S[4] + $S[5];
+      next if $sum != $S[5] + $S[6];
+      my @keys = 'a' .. 'g';
+      my %retval;
+      @retval{@keys} = @S;
+      return %retval;
+   }
+   return;
+}
+
+my @input = @ARGV == 7 ? @ARGV : 1 .. 7;
+my %solution = four_squares_puzzle(shuffle @input);
+if (! scalar keys %solution) {
+   say 'no solution, sooooorry!';
+}
+else {
+   for my $key (sort keys %solution) {
+      say "$key = $solution{$key}";
+   }
+}
+
+sub permutations_iterator {
+   my %args = (@_ && ref($_[0])) ? %{$_[0]} : @_;
+   my $items = $args{items} || die "invalid or missing parameter 'items'";
+   my $filter = $args{filter} || sub { wantarray ? @_ : [@_] };
+   my @indexes = 0 .. $#$items;
+   my @stack = (0) x @indexes;
+   my $sp = undef;
+   return sub {
+      if (! defined $sp) { $sp = 0 }
+      else {
+         while ($sp < @indexes) {
+            if ($stack[$sp] < $sp) {
+               my $other = $sp % 2 ? $stack[$sp] : 0;
+               @indexes[$sp, $other] = @indexes[$other, $sp];
+               $stack[$sp]++;
+               $sp = 0;
+               last;
+            }
+            else {
+               $stack[$sp++] = 0;
+            }
+         }
+      }
+      return $filter->(@{$items}[@indexes]) if $sp < @indexes;
+      return;
+   }
+}