diff options
| -rwxr-xr-x | challenge-121/jo-37/perl/ch-1.pl | 60 | ||||
| -rwxr-xr-x | challenge-121/jo-37/perl/ch-2.pl | 239 |
2 files changed, 299 insertions, 0 deletions
diff --git a/challenge-121/jo-37/perl/ch-1.pl b/challenge-121/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..be854bb6df --- /dev/null +++ b/challenge-121/jo-37/perl/ch-1.pl @@ -0,0 +1,60 @@ +#!/usr/bin/perl -s + +use v5.16; +use Test2::V0; +use experimental 'signatures'; + +our ($tests, $examples); + +run_tests() if $tests || $examples; # does not return + +die <<EOS unless @ARGV == 2; +usage: $0 [-examples] [-tests] [M N] + +-examples + run the examples from the challenge + +-tests + run some tests + +M + number to be processed + +N + bit position + +EOS + + +### Input and Output + +say invert_nth_bit($ARGV[0], $ARGV[1]); + + +### Implementation + +sub invert_nth_bit ($m, $n) { + $m ^ 1 << ($n - 1); +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + + is invert_nth_bit(12, 3), 8, 'example 1'; + is invert_nth_bit(18, 4), 26, 'example 2'; + } + + SKIP: { + skip "tests" unless $tests; + + is invert_nth_bit(0, 32), 2 ** 31, 'not limited to N <= 8'; + is invert_nth_bit(2 ** 31, 32), 0, 'not limited to M < 256'; + } + + done_testing; + exit; +} diff --git a/challenge-121/jo-37/perl/ch-2.pl b/challenge-121/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..37f468ccb2 --- /dev/null +++ b/challenge-121/jo-37/perl/ch-2.pl @@ -0,0 +1,239 @@ +#!/usr/bin/perl -s + +use v5.16; +use Test2::V0; +use Math::Prime::Util qw(forcomb forperm); +use List::Util 'reduce'; +use Benchmark 'cmpthese'; +use experimental 'signatures'; +use Data::Dump; + +our ($examples, $verbose, $size, $max, $benchmark, $perm); +$max //= 10; + +run_tests() if $examples; # does not return + +die <<EOS unless @ARGV || $size; +usage: $0 [-examples] [-verbose] [-size=N] [-max=M] [-benchmark] [-perm] + [d11,d12,...,d1N ... dN1,dN2,...dNN] + +-examples + run the examples from the challenge + +-verbose + print final internal data structures + +-size=N + generate a random NxN distance matrix + +-max=M + use M as the maximum distance when generating a random matrix + Default: 10 + +-benchmark + run a benchmark comparing the Held-Karp implementation and a brute + force trial + +-perm + use a brute force implementation instead of the Held-Karp algorithm + +d11,d12,...,d1N ... dN1,dN2,...dNN + build the distance matrix from the elements dij where columns are + numerical values separated by comma and/or optional space and rows are + the arguments to $0. + + The example may be specified as: + $0 0,5,2,7 5,0,5,3 3,1,0,6 4,5,4,0 + or (combining some row formats): + $0 '0 5 2 7' '5, 0, 5, 3' '3 1 0 6' 4,5,4,0 + + +EOS + + +### Input and Output + +my $dist; + +# Use a random distance matrix. +if ($size && !@ARGV) { + $dist = rand_dist($size, $max); +} + +# Use the provided distance matrix. +if (@ARGV) { + $dist = build_dist(@ARGV); +} + +my ($cycle, $length) = $perm ? tsp_perm($dist) : tsp_held_karp($dist); +say "length=$length"; +say "tour=(@$cycle)"; + +# Compare Held-Carp and brute force for the given parametrization. +if ($benchmark) { + cmpthese(0, { + held_karp => sub {tsp_held_karp($dist)}, + permute => sub {tsp_perm($dist)}, + }); +} + +### Implementation + +# Solving the asymmetric travelling salesman problem (aTSP) using the +# Held-Karp algorithm, see +# https://en.wikipedia.org/wiki/Held-Karp_algorithm. +# This algorithm provides an exact solution and becomes faster than a +# brute-force scan of all permutations for matrix sizes above 6x6. The +# price is a rather high memory consumption. This implementation is +# capable of solving an aTSP with a size of 20 in less than one minute +# but needs more than 1 GB of memory for this task. Using GNU "time" +# instead of the shell builtin reports for -size=20: +# 42.48user 0.46system 0:43.01elapsed 99%CPU +# (0avgtext+0avgdata 1236032maxresident)k +# +# Cities are identified by a zero-based index. The tour starts and ends +# in 0. +sub tsp_held_karp ($dist) { + # $c{"@s"}{$c} is the minimum distance from 0 to $c visiting all + # cities in @s. The key for %c is a set. Here a set is represented + # by a space separated, ordered list of its elements. + my %c; + # $p{"@s"}{$c} is the predecessor of $c when visiting all cities in + # @s, i.e. the city in @s where the minimum $c{"@s"}{$c} is taken. + my %p; + # The values of %c are trivial for singletons @s = ($c). + $c{$_}{$_} = $dist->[0][$_] for 1 .. $#$dist; + # Loop over all subsets of at least two cities and omitting 0. + for my $s (2 .. @$dist - 1) { + forcomb { + # Get the current subset of $s cities. + my @s = @{[1 .. @$dist - 1]}[@_]; + # Loop over all the cities in the set. + for my $k (@s) { + # Remove the current city from the set. + my @s_k = grep {$_ != $k} @s; + # Dynamic programming: + # The set @s_k (i.e. S\{k}) has one element less than @s + # and thus all the minimum distances from 0 to any city + # in @s_k via @s_k are already known. This allows to + # calculate the minimum distance from 0 to $k via all + # cities in @s. Keeping track of the actual predecessor + # in @s_k. + my $min = 'inf'; + my $p; + for my $m (@s_k) { + my $cm = $c{"@s_k"}{$m} + $dist->[$m][$k]; + if ($cm < $min) { + $min = $cm; + $p = $m; + } + } + $c{"@s"}{$k} = $min; + $p{"@s"}{$k} = $p; + } + } @$dist - 1, $s; + } + # To complete the circle: for all cities in the full set of all + # cities except the start find the minimum from the start to that + # city plus the distance back to the start. + my $min = 'inf'; + my $last; + for my $k (1 .. $#$dist) { + if ((my $m = $c{"@{[1 .. $#$dist]}"}{$k} + $dist->[$k][0]) < $min) { + $min = $m; + $last = $k; + } + } + if ($verbose) { + say "last: $last"; + say '%c:'; + dd \%c; + say '%p:'; + dd \%p; + } + + # So far this was almost straight from the wiki pseudo code. Now + # building the actual circle. We only know the last city in the + # tour yet but are able to backtrack using %p. + my @circle = ($last, 0); + # The set of all cities except 0. + my @remainder = 1 .. $#$dist; + while (@remainder > 1) { + # Find the predecessor. + my $pred = $p{"@remainder"}{$last}; + unshift @circle, $pred; + # Remove the last city from the set and make its predecessor + # the new last city. + @remainder = grep {$_ != $last} @remainder; + $last = $pred; + } + # Complete the circle with the start. + unshift @circle, 0; + (\@circle, $min); +} + +# Brute force solution over all permutations of N - 1 cities. This +# implementation is just a slight variation of the sub used in challenge +# 118. +# +# Benchmark for N=9: +# Rate permute held_karp +# permute 8.71/s -- -96% +# held_karp 249/s 2756% -- +# +sub tsp_perm ($dist) { + my @r = (1 .. $#$dist); + my @circle; + my $min = 'inf'; + forperm { + my @tour = @r[@_]; + my $len; + # Abuse "reduce" as a sliding window. + reduce { + $len += $dist->[$a][$b]; + $b; + } 0, @tour, 0; + if ($len < $min) { + @circle = (0, @tour, 0); + $min = $len; + } + } $#$dist; + (\@circle, $min); +} + +# Create a random distance matrix with given size and maximum distance. +sub rand_dist ($size, $max) { + my @d; + for my $i (0 .. $size - 1) { + for my $j (0 .. $size - 1) { + $d[$i][$j] = $i == $j ? 0 : 1 + int rand $max; + } + } + dd \@d; + + \@d; +} + +# Build a distance matrix from given rows/columns. +sub build_dist (@matrix) { + my @d; + push @d, [split /[ ,] */, $_] for @matrix; + + dd \@d if $verbose; + + \@d; +} + + +### Examples and tests + +sub run_tests { + is [tsp_held_karp([ + [0, 5, 2, 7], + [5, 0, 5, 3], + [3, 1, 0, 6], + [4, 5, 4 ,0]])], [[0, 2, 1, 3, 0], 10], 'example'; + + done_testing; + exit; +} |