- Added solutions by Flavio Poletti.

4 files changed, 143 insertions, 0 deletions

diff --git a/challenge-089/polettix/blog.txt b/challenge-089/polettix/blog.txt
new file mode 100644
index 0000000000..db5415038e
--- /dev/null
+++ b/challenge-089/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2020/12/01/pwc089-gcd-sum/
diff --git a/challenge-089/polettix/blog1.txt b/challenge-089/polettix/blog1.txt
new file mode 100644
index 0000000000..2bcf247b1d
--- /dev/null
+++ b/challenge-089/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2020/12/02/pwc089-magical-matrix/
diff --git a/challenge-089/polettix/perl/ch-1.pl b/challenge-089/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..b5da2c4017
--- /dev/null
+++ b/challenge-089/polettix/perl/ch-1.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+
+sub gcd { my ($A, $B) = @_; ($A, $B) = ($B % $A, $A) while $A; return $B }
+
+sub GCD_sum ($N) {
+   my $sum = $N - 1; # gcd(1, $x) = 1
+   for my $lo (2 .. $N - 1) {
+      $sum += gcd($lo, $_) for $lo + 1 .. $N;
+   }
+   return $sum;
+}
+
+say GCD_sum(shift || 4);
diff --git a/challenge-089/polettix/perl/ch-2.pl b/challenge-089/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..b963f46932
--- /dev/null
+++ b/challenge-089/polettix/perl/ch-2.pl
@@ -0,0 +1,124 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+use Storable 'dclone';
+
+my $M = magical_matrix(shift || 3);
+say {*STDOUT} '[ ', (map { sprintf '%3d', $_ } $_->@*), ' ]' for $M->@*;
+
+sub magical_matrix ($N) {
+   my $N2 = $N * $N;
+   my $solution = solve_by_constraints(
+      start => {
+         not_allocated => { map {$_ => 1} 1 .. $N2 },
+         field => [ (0) x $N2 ],
+         fine  => {},
+      },
+      is_done => sub ($state) { keys($state->{not_allocated}->%*) == 0 },
+      constraints => [
+         (map {_constraint($N, $_ * $N,  1)} 0 .. ($N - 1)), # rows
+         (map {_constraint($N, $_,      $N)} 0 .. ($N - 1)), # cols
+         _constraint($N, 0,      $N + 1),                    # main diag
+         _constraint($N, $N - 1, $N - 1),                    # other diag
+      ],
+      search_factory => \&_search_factory,
+   ) or die "cannot find a solution for N = $N\n";
+   my $field = $solution->{field};
+   return [map {[splice $field->@*, 0, $N]} 1 .. $N];
+}
+
+sub _search_factory ($state) {
+   my %not_allocated = $state->{not_allocated}->%*;
+   my @candidates = keys %not_allocated;
+   my $current = undef;
+
+   my @field = $state->{field}->@*;
+   my $pos = undef;
+   for my $i (0 .. $#field) {
+      next if $field[$i];
+      $pos = $i;
+      last;
+   }
+   die 'no unassigned position (WTF?!?)' unless defined $pos;
+
+   my %fine = $state->{fine}->%*;
+
+   return sub ($state) {
+      return 0 unless @candidates;
+
+      $not_allocated{$current} = 1 if defined $current;
+      $current = shift @candidates;
+      delete $not_allocated{$current};
+
+      $field[$pos] = $current;
+      $state->{field}   = [@field];
+      $state->{not_allocated} = { %not_allocated };
+      $state->{fine} = { %fine };
+
+      return 1;
+   };
+}
+
+sub _constraint ($N, $start, $delta) {
+   my $N2 = $N * $N;
+   my $target_sum = ($N2 + 1) * $N / 2;
+   return sub ($state) {
+      return 0 if $state->{fine}{"$start-$delta"};
+      my ($field, $not_allocated) = $state->@{qw< field not_allocated >};
+      my $available = $target_sum;
+      my @missing_indexes;
+      my $j = 0;
+      while ($j < $N) {
+         my $i = $start + $delta * $j++;
+         if (my $v = $field->[$i]) { $available -= $v }
+         else                      { push @missing_indexes, $i }
+      }
+      die "wrong sum, too much" if $available < 0;
+      my $n_missing = scalar @missing_indexes;
+
+      if ($n_missing == 0) { # every value is fixed here, check the sum
+         die 'wrong sum' if $available;
+         $state->{fine}{"$start-$delta"} = 1;
+         return 0; # check OK, no change
+      }
+
+      if ($n_missing == 1) { # fix the one that's left
+         die "invalid residual value"
+            unless exists $not_allocated->{$available};
+         delete $not_allocated->{$available};
+         $field->[$missing_indexes[0]] = $available;
+         return 1; # yes, we did one change
+      }
+
+      return 0; # no change happened
+   }
+}
+
+sub solve_by_constraints {
+   my %args = (@_ && ref($_[0])) ? %{$_[0]} : @_;
+   my @reqs = qw< constraints is_done search_factory start >;
+   exists($args{$_}) || die "missing parameter '$_'" for @reqs;
+   my ($constraints, $done, $factory, $state, @stack) = @args{@reqs};
+   my $logger = $args{logger} // undef;
+   while ('necessary') {
+      last if eval {    # eval - constraints might complain loudly...
+         $logger->(validating => $state) if $logger;
+         my $changed = -1;
+         while ($changed != 0) {
+            $changed = 0;
+            $changed += $_->($state) for @$constraints;
+            $logger->(pruned => $state) if $logger;
+         } ## end while ($changed != 0)
+         $done->($state) || (push(@stack, $factory->($state)) && undef);
+      };
+      $logger->(backtrack => $state, $@) if $logger;
+      while (@stack) {
+         last if $stack[-1]->($state);
+         pop @stack;
+      }
+      return unless @stack;
+   } ## end while ('necessary')
+   return $state;
+} ## end sub solve_by_constraints