diff options
| -rw-r--r-- | challenge-121/polettix/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-121/polettix/blog1.txt | 1 | ||||
| -rw-r--r-- | challenge-121/polettix/perl/ch-1.pl | 9 | ||||
| -rw-r--r-- | challenge-121/polettix/perl/ch-2.pl | 144 | ||||
| -rw-r--r-- | challenge-121/polettix/raku/ch-1.raku | 8 | ||||
| -rw-r--r-- | challenge-121/polettix/raku/ch-2.raku | 83 |
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; |