Merge pull request #7654 from jacoby/master

#206 DAJ

3 files changed, 99 insertions, 0 deletions

diff --git a/challenge-206/dave-jacoby/blog.txt b/challenge-206/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..13a7a2d887
--- /dev/null
+++ b/challenge-206/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2023/02/28/partial-content-weekly-challenge-206.html
\ No newline at end of file
diff --git a/challenge-206/dave-jacoby/perl/ch-1.pl b/challenge-206/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..987149a0af
--- /dev/null
+++ b/challenge-206/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use DateTime;
+
+my @examples = (
+
+    [ "00:00", "23:55", "20:00" ],
+    [ "01:01", "00:50", "00:57" ],
+    [ "10:10", "09:30", "09:00", "09:55" ],
+    [ "03:00", "06:01", "09:02" ],
+);
+
+for my $e (@examples) {
+    my $list = join ',', map { qq{"$_"} } $e->@*;
+    my $out  = shortest_time( $e->@* );
+    say <<"END";
+    Input:  \@array = ($list)
+    Output: $out
+END
+}
+
+sub shortest_time ( @array ) {
+    my @output;
+    my $day_length      = 86400;             # give or take leap seconds, etc
+    my $half_day_length = $day_length / 2;
+    return 0 unless scalar @array > 1;
+    my @times = map { make_time($_) } @array;
+    for my $i ( 0 .. -2 + scalar @array ) {
+        my $t1 = $times[$i];
+        for my $j ( $i + 1 .. -1 + scalar @array ) {
+            my $t2   = $times[$j];
+            my $diff = $t1->subtract_datetime_absolute($t2)->seconds;
+            if ( $diff > $half_day_length ) { $diff = $day_length - $diff; }
+            push @output, $diff / 60;        # cast as int?
+        }
+    }
+    return ( sort { $a <=> $b } @output )[0];
+}
+
+sub make_time ( $string ) {
+    my ( $hr, $min ) = split /:/, $string;
+    return DateTime->now->set_hour($hr)->set_minute($min)->set_second(0)
+        ->set_time_zone('floating');
+}
diff --git a/challenge-206/dave-jacoby/perl/ch-2.pl b/challenge-206/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..50bfefafd9
--- /dev/null
+++ b/challenge-206/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Util qw{ sum0 min max };
+use Getopt::Long;
+
+my $verbose = 0;
+GetOptions( verbose => \$verbose, );
+
+my @examples = (
+
+    [ 1, 2, 3, 4 ],
+    [ 0, 2, 1, 3 ],
+    [ 2, 4, 6, 8, 10, 12 ],
+    [ 1, 2, 3, 4, 5,  6, 7, 8 ],
+);
+
+for my $e (@examples) {
+    my $o     = array_pairings($e);
+    my $array = join ', ', $e->@*;
+    say <<"END";
+    Input:  \@array = $array
+    Output: $o
+END
+}
+
+sub array_pairings ( $array, $pairs = [] ) {
+    my @output;
+    if ( !scalar $array->@* ) {
+        my $sum = sum0 map { min $_->@* } $pairs->@*;
+        say join ' ', '|', ( map { join 'x', $_->@* } $pairs->@* ), '', $sum
+            if $verbose;
+        return $sum;
+    }
+    for my $i ( 1 .. -1 + scalar $array->@* ) {
+        my @array_copy = $array->@*;
+        my @pairs_copy = $pairs->@*;
+        my $y          = $array_copy[$i];
+        $array_copy[$i] = undef;
+        @array_copy = grep { defined } @array_copy;
+        my $x = shift @array_copy;
+        push @pairs_copy, [ $x, $y ];
+        push @output,     array_pairings( \@array_copy, \@pairs_copy );
+    }
+    say '  ' . join ' ', @output if $verbose;
+    return max @output;
+}