Merge pull request #4511 from jacoby/master

11x11 == 121 (just did an 11x11 random matrix to test)

6 files changed, 184 insertions, 0 deletions

diff --git a/challenge-120/dave-jacoby/blog.txt b/challenge-120/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..0f29f7f2da
--- /dev/null
+++ b/challenge-120/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/07/05/its-about-time-weekly-challenge-120.html
diff --git a/challenge-120/dave-jacoby/perl/ch-1.pl b/challenge-120/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..8e21ea4327
--- /dev/null
+++ b/challenge-120/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+
+use feature qw{say state signatures};
+use strict;
+use warnings;
+use utf8;
+no warnings qw{ experimental };
+
+for my $n ( 18, 101 ) {
+    say join "\t", '', $n, swap_bits($n);
+}
+
+sub swap_bits ($n) {
+    my $b = sprintf '%08b', $n;
+    my $r = join '', map { scalar reverse($_) } ( $b =~ /../g );
+    my $s = oct( '0b' . $r );
+    return $s;
+}
diff --git a/challenge-120/dave-jacoby/perl/ch-2.pl b/challenge-120/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..43b342f01c
--- /dev/null
+++ b/challenge-120/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental };
+
+my @times = qw{ 3:10 4:00 4:20 6:00 11:59 12:00 3:21 };
+@times = map { "11:$_" } 20 .. 65;
+
+for my $time (@times) {
+    $time = fix_time($time);
+    my $angle = clock_angle($time);
+    say join "\t", '', $time, $angle;
+}
+
+sub fix_time ($time) {
+    my ( $hour, $minute ) = split /:/, $time;
+    $hour += 1 if $minute >= 60;
+    $minute = sprintf '%02d', $minute % 60;
+    $hour   = $hour % 12;
+    $hour   = $hour ? $hour : 12;
+    return join ':', $hour, $minute;
+}
+
+sub clock_angle ($time) {
+    my ( $hour, $minute ) = split /:/, $time;
+    my $minute_angle = minute_angle($minute);
+    my $hour_angle   = hour_angle( $hour, $minute );
+    my ( $min, $max ) = sort $minute_angle, $hour_angle;
+    my $angle = $max - $min;
+    if ( $angle > 180 ) {
+        $angle = abs $min - $max;
+    }
+    if ( $angle > 180 ) {
+        $angle = 360 - $angle;
+    }
+    return $angle;
+}
+
+sub hour_angle ( $hour, $minute ) {
+    $hour++ if $minute > 60;
+    return ( ( $hour % 12 ) * 30 ) + ( ( $minute % 60 ) / 2 );
+}
+
+sub minute_angle ($minute) {
+    return 6 * ( $minute % 60 );
+}
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;
+}