diff options
| -rw-r--r-- | challenge-121/dave-jacoby/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-121/dave-jacoby/perl/ch-1.pl | 31 | ||||
| -rw-r--r-- | challenge-121/dave-jacoby/perl/ch-2.pl | 85 |
3 files changed, 117 insertions, 0 deletions
diff --git a/challenge-121/dave-jacoby/blog.txt b/challenge-121/dave-jacoby/blog.txt new file mode 100644 index 0000000000..01099188c9 --- /dev/null +++ b/challenge-121/dave-jacoby/blog.txt @@ -0,0 +1 @@ +://jacoby.github.io/2021/07/13/bitty-tours-perl-weekly-challenge-121.htmlttps://jacoby.github.io/2021/06/14/trees-and-rows-perl-weekly-challenge-117.html diff --git a/challenge-121/dave-jacoby/perl/ch-1.pl b/challenge-121/dave-jacoby/perl/ch-1.pl new file mode 100644 index 0000000000..d241b48fd3 --- /dev/null +++ b/challenge-121/dave-jacoby/perl/ch-1.pl @@ -0,0 +1,31 @@ +#!/usr/bin/env perl + +use feature qw{say state signatures}; +use strict; +use warnings; +use utf8; +no warnings qw{ experimental }; + +use Getopt::Long; +use Carp; + +my $m = 0; +my $n = 1; +GetOptions( + 'm=i' => \$m, + 'n=i' => \$n, +); +croak q{M out of range} if $m > 255 || $m < 0; +croak q{N out of range} if $n > 8 || $n < 1; + +my $o = invert_bit( $m, $n ); +print <<"END"; + m $m n $n o $o +END + +sub invert_bit ( $m = 0, $n = 1 ) { + my $bin = sprintf '%08b', $m; + my $nn = 8 - $n; + substr( $bin, $nn, 1 ) = 1 - substr( $bin, $nn, 1 ); + return oct( '0b' . $bin ); +} diff --git a/challenge-121/dave-jacoby/perl/ch-2.pl b/challenge-121/dave-jacoby/perl/ch-2.pl new file mode 100644 index 0000000000..0faa866711 --- /dev/null +++ b/challenge-121/dave-jacoby/perl/ch-2.pl @@ -0,0 +1,85 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature qw{ postderef say signatures state }; +no warnings qw{ experimental }; + +use Carp; +use Getopt::Long; +use List::Util qw{sum0}; + +my $n = 0; +my $map = [ [ 0, 5, 2, 7 ], [ 5, 0, 5, 3 ], [ 3, 1, 0, 6 ], [ 4, 5, 4, 0 ], ]; + +GetOptions( 'n=i' => \$n, ); +croak q{N out of range} if $n > 20 || $n < 0; + +if ( $n > 0 ) { + $map = build_random_map($n); +} + +my @final_tour; +my $f = 1000000; +travelling_salesman($map); +my $tour = join ' ', @final_tour; + +say <<"END"; + length: $f + tour: $tour +END + +say join "\n", '', map { join ' ', $_->@* } $map->@*; + +sub travelling_salesman ( $map, $loc = 0, $tour = [] ) { + push $tour->@*, $loc; + my $l = tour_length( $map, $tour ); + return unless $l < $f; + + my %tour = map { ( $_, 1 ) } $tour->@*; + my @options = grep { !$tour{$_} } 0 .. -1 + scalar $map->@*; + + if ( scalar @options ) { + for my $o (@options) { + my $next->@* = $tour->@*; + travelling_salesman( $map, $o, $next ); + } + } + else { + push $tour->@*, $tour->[0]; + my $l = tour_length( $map, $tour ); + say join ' ', 'END', $l, '', $f, '', $tour->@*; + if ( $l < $f ) { + @final_tour = $tour->@*; + $f = $l; + } + } +} + +sub tour_length ( $map, $tour ) { + my $n = -1 + scalar $map->@*; + my @dist; + for my $i ( 0 .. $n ) { + my $j = $i + 1; + next unless $tour->[$i]; + next unless $tour->[$j]; + my $x = $tour->[$i]; + my $y = $tour->[$j]; + my $d = $map->[$x][$y]; + push @dist, $d; + } + return sum0 @dist; +} + +sub build_random_map ( $n ) { + my $output = []; + for my $i ( 0 .. -1 + $n ) { + for my $j ( $i .. -1 + $n ) { + my $r = 1 + int rand 9; + $output->[$i][$j] = $r; + $output->[$j][$i] = $r; + $output->[$i][$j] = 0 if $i == $j; + } + } + return $output; +} |