Merge branch 'master' of https://github.com/manwar/perlweeklychallenge-club

6 files changed, 246 insertions, 0 deletions

diff --git a/challenge-121/polettix/blog.txt b/challenge-121/polettix/blog.txt
new file mode 100644
index 0000000000..040d534325
--- /dev/null
+++ b/challenge-121/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/07/14/pwc121-invert-bit/
diff --git a/challenge-121/polettix/blog1.txt b/challenge-121/polettix/blog1.txt
new file mode 100644
index 0000000000..52853b42f0
--- /dev/null
+++ b/challenge-121/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/07/15/pwc121-the-travelling-salesman/
diff --git a/challenge-121/polettix/perl/ch-1.pl b/challenge-121/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..31bb5a1850
--- /dev/null
+++ b/challenge-121/polettix/perl/ch-1.pl
@@ -0,0 +1,9 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+sub invert_bit ($m, $n) { $m ^ (1 << --$n) }
+say "m=12 n=3 -> " . invert_bit(12, 3);
+say "m=18 n=4 -> " . invert_bit(18, 4);
diff --git a/challenge-121/polettix/perl/ch-2.pl b/challenge-121/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..543b0d697f
--- /dev/null
+++ b/challenge-121/polettix/perl/ch-2.pl
@@ -0,0 +1,144 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+sub travelling_salesman_problem ($dist_from_to) {
+   my $n = $dist_from_to->@*;
+   my @U = 1 .. $n - 1;
+   my %g = map { $_ => $dist_from_to->[0][$_] } @U;
+   my %p = map { $_ => 0 } @U;
+   for my $size (2 .. $n - 1) {
+      my $cit = combinations_iterator($size, @U);
+      while (my @S = $cit->()) {
+         for my $e (@S) {
+            my @Se = grep { $_ != $e } @S;
+            my $eSe_key = join ',', $e, @Se;
+            for my $m (@Se) {
+               my @Sem = grep { $_ != $m } @Se;
+               my $mSem_key = join ',', $m, @Sem;
+               my $candidate = $g{$mSem_key} + $dist_from_to->[$m][$e];
+               ($g{$eSe_key}, $p{$eSe_key}) = ($candidate, $m)
+                  if ! exists $g{$eSe_key} || $candidate < $g{$eSe_key};
+            }
+         }
+      }
+   }
+   my ($opt, $opt_dist);
+   for my $e (@U) {
+      my @Se = grep { $_ != $e } @U;
+      my $eSe_key = join ',', $e, @Se;
+      my $candidate = $g{$eSe_key} + $dist_from_to->[$e][0];
+      ($opt, $opt_dist) = ($e, $candidate)
+         if ! defined($opt_dist) || $candidate < $opt_dist;
+   }
+
+   my @path = (0);
+   my @S = @U;
+   my $e = $opt;
+   while ($e) {
+      unshift @path, $e;
+      @S = grep { $_ != $e } @S;
+      my $key = join ',', $e, @S;
+      $e = $p{$key};
+   }
+   unshift @path, 0;
+   return ($opt_dist, \@path);
+}
+
+sub tsp_bf ($dist_from_to) {
+   my $n = $dist_from_to->@*;
+   my ($best_distance, $best_path);
+   my $pit = permutations_iterator(items => [1 .. $n - 1]);
+   while (my @perm = $pit->()) {
+      my ($from, $sum) = (0, 0);
+      for my $to (@perm, 0) {
+         $sum += $dist_from_to->[$from][$to];
+         $from = $to;
+      }
+      ($best_distance, $best_path) = ($sum, [@perm])
+        if !defined($best_distance) || $sum < $best_distance;
+   } ## end while (my @perm = $pit->(...))
+   return ($best_distance, [0, $best_path->@*, 0]);
+} ## end sub tsp_bf ($dist_from_to)
+
+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;
+            } ## end if ($stack[$sp] < $sp)
+            else {
+               $stack[$sp++] = 0;
+            }
+         } ## end while ($sp < @indexes)
+      } ## end else [ if (!defined $sp) ]
+      return $filter->(@{$items}[@indexes]) if $sp < @indexes;
+      return;
+     }
+} ## end sub permutations_iterator
+
+sub combinations_iterator ($k, @items) {
+   my @indexes = (0 .. ($k - 1));
+   my $n = @items;
+   return sub {
+      return unless @indexes;
+      my (@combination, @remaining);
+      my $j = 0;
+      for my $i (0 .. ($n - 1)) {
+         if ($j < $k && $i == $indexes[$j]) {
+            push @combination, $items[$i];
+            ++$j;
+         }
+         else {
+            push @remaining, $items[$i];
+         }
+      } ## end for my $i (0 .. ($n - 1...))
+      for my $incc (reverse(-1, 0 .. ($k - 1))) {
+         if ($incc < 0) {
+            @indexes = ();    # finished!
+         }
+         elsif ((my $v = $indexes[$incc]) < $incc - $k + $n) {
+            $indexes[$_] = ++$v for $incc .. ($k - 1);
+            last;
+         }
+      } ## end for my $incc (reverse(-1...))
+      return @combination;
+     }
+} ## end sub combinations_iterator
+
+sub generate_randoms ($n) {
+   my @retval;
+   for my $i (0 .. $n - 1) {
+      my @row = map { 1 + int(rand 13) } 1 .. $n;
+      $row[$i] = 0;
+      push @retval, \@row;
+   }
+   return \@retval;
+}
+
+my $n = shift || 4;
+my $dft = generate_randoms($n);
+
+if ($n < 10) { # limit brute-force
+   my ($dist, $path) = tsp_bf($dft);
+   say "$dist ($path->@*)";
+}
+
+{ # Held-Karp algorithm
+   my ($dist, $path) = travelling_salesman_problem($dft);
+   say "$dist ($path->@*)";
+}
diff --git a/challenge-121/polettix/raku/ch-1.raku b/challenge-121/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..1202299283
--- /dev/null
+++ b/challenge-121/polettix/raku/ch-1.raku
@@ -0,0 +1,8 @@
+#!/usr/bin/env raku
+use v6;
+subset IntByte of Int where 0 <= * <= 255;
+subset BitNum  of Int where 1 <= * <= 8;
+sub invert-bit (IntByte:D $m, BitNum:D $n) { $m +^ (1 +< ($n - 1)) }
+
+put "m=12 n=3 -> " ~ invert-bit(12, 3);
+put "m=18 n=4 -> " ~ invert-bit(18, 4);
diff --git a/challenge-121/polettix/raku/ch-2.raku b/challenge-121/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..7bfada4614
--- /dev/null
+++ b/challenge-121/polettix/raku/ch-2.raku
@@ -0,0 +1,83 @@
+#!/usr/bin/env raku
+use v6;
+
+sub travelling-salesman-problem ($dist-from-to) {
+   my $n = $dist-from-to.elems;
+   my \U = 1 ..^ $n;
+   my %g = map { $_ => $dist-from-to[0][$_] }, U;
+   my %p = map { $_ => 0 }, U;
+   for 2 ..^ $n -> $size {
+      for combinations(U, $size) -> $S {
+         for |$S -> $e {
+            my $Se = $S (-) $e;
+            my $eSe-key = ($e, $Se.keys.sort.Slip).join(',');
+            for $Se.keys -> $m {
+               my $Sem = $Se (-) $m;
+               my $mSem-key = ($m, $Sem.keys.sort.Slip).join(',');
+               my $candidate = %g{$mSem-key} + $dist-from-to[$m][$e];
+               (%g{$eSe-key}, %p{$eSe-key}) = ($candidate, $m)
+                  if %g{$eSe-key}:!exists || $candidate < %g{$eSe-key};
+            }
+         }
+      }
+   }
+   my ($opt, $opt-dist);
+   for U -> $e {
+      my $Se = U (-) $e;
+      my $eSe-key = ($e, $Se.keys.sort.Slip).join(',');
+      my $candidate = %g{$eSe-key} + $dist-from-to[$e][0];
+      ($opt, $opt-dist) = ($e, $candidate)
+         if ! defined($opt-dist) || $candidate < $opt-dist;
+   }
+   my @path = 0;
+   my $S = U;
+   my $e = $opt;
+   while $e {
+      @path.unshift: $e;
+      $S = $S (-) $e;
+      my $key = ($e, $S.keys.sort.Slip).join(',');
+      $e = %p{$key};
+   }
+   @path.unshift: 0;
+   ($opt-dist, @path.List);
+}
+
+sub tsp-bf ($dist-from-to) {
+   my $n = $dist-from-to.elems;
+   my ($best-distance, $best-path);
+   for permutations(1 .. $n - 1) -> $perm {
+      my $from = 0;
+      my $sum = 0;
+      for |$perm, 0 -> $to {
+         $sum += $dist-from-to[$from][$to];
+         $from = $to;
+      }
+      ($best-distance, $best-path) = ($sum, $perm)
+         if ! defined($best-distance) || $sum < $best-distance;
+   }
+   return ($best-distance, (0, |$best-path, 0));
+}
+
+sub generate-randoms ($n) {
+   my @retval;
+   for 0 ..^ $n -> $i {
+      my @row = (1 .. $n).map({1 + 13.rand.Int});
+      @row[$i] = 0;
+      @retval.push: @row.List;
+   }
+   return @retval;
+}
+
+# my $dft = (
+#    [0, 5, 2, 7, 9],
+#    [5, 0, 5, 3, 1],
+#    [3, 1, 0, 6, 2],
+#    [4, 5, 4, 0, 12],
+#    [1, 5, 7, 2, 0],
+# );
+
+my $n = @*ARGS ?? @*ARGS.shift !! 4;
+my $dft = generate-randoms($n);
+
+tsp-bf($dft).say if $n < 8;
+travelling-salesman-problem($dft).say;