Challenge 206 Perl solutions by Matthias Muth

3 files changed, 110 insertions, 5 deletions

diff --git a/challenge-206/matthias-muth/README.md b/challenge-206/matthias-muth/README.md
index 758f229f45..8152988cdd 100644
--- a/challenge-206/matthias-muth/README.md
+++ b/challenge-206/matthias-muth/README.md
@@ -1,10 +1,14 @@
-# Uniq anyone?
-**Challenge 205 solutions in Perl by Matthias Muth**
+# All the permutations...
+**Challenge 206 solutions in Perl by Matthias Muth**
 
-## Task 1: Third Highest
+## Task 1: Shortest Time
 
-> You are given an array of integers.<br/>
-Write a script to find out the _Third Highest_ if found otherwise return the maximum.
+> You are given a list of time points, at least 2, in the 24-hour clock format `HH:MM`.<br/>
+> Write a script to find out the shortest time in minutes between any two time points.
+
+The examples given are important for understanding that the shortest time between two time points might also span over midnight.
+
+##### CONTINUE HERE
 
 Thinking about a solution I start at the end:<br/>
 I imagine simply getting the result from the ordered list of input values -- just take the third value, and it there isn't any, take the first. So sort and return -- easy!
diff --git a/challenge-206/matthias-muth/ch-1.pl b/challenge-206/matthias-muth/ch-1.pl
new file mode 100755
index 0000000000..b1ad5dbf2e
--- /dev/null
+++ b/challenge-206/matthias-muth/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'signatures';
+no warnings 'experimental::signatures';
+
+use List::Util qw( min );
+
+sub time_diffs( @t ) {
+    map { my $d = abs( $t[0] - $t[$_] ); min( $d, (24*60) - $d ); } 1..$#t;
+}
+
+sub shortest_time( @hhmm_times ) {
+    my @t = map { /^(\d+):(\d{2})$/; $1 * 60 + $2 } @hhmm_times;
+    return min( map time_diffs( @t[$_..$#t] ), 0..$#t );
+}
+
+
+use Test::More;
+
+my @tests = (
+    [ [ "00:04", "23:55", "20:00" ], 9 ],
+    [ [ "00:00", "23:55", "20:00" ], 5 ],
+    [ [ "01:01", "00:50", "00:57" ], 4 ],
+    [ [ "10:10", "09:30", "09:00", "09:55" ], 15 ],
+);
+
+is shortest_time( @{$_->[0]} ), $_->[1],
+    "shortest_time( @{$_->[0]} ) == " . ( $_->[1] // "undef" )
+    for @tests;
+
+done_testing;
diff --git a/challenge-206/matthias-muth/ch-2.pl b/challenge-206/matthias-muth/ch-2.pl
new file mode 100755
index 0000000000..76758886f5
--- /dev/null
+++ b/challenge-206/matthias-muth/ch-2.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use feature 'signatures';
+no warnings 'experimental::signatures';
+
+use List::Util qw( min max sum );
+
+sub permute( $a_ref ) {
+    return undef  unless defined $a_ref && ref $a_ref eq 'ARRAY';
+    return ()     if @$a_ref == 0;
+    return $a_ref if @$a_ref == 1;
+
+    my @permutations;
+    for my $i ( 0..$#$a_ref ) {
+	my @others = @$a_ref;
+	my $extracted = splice( @others, $i, 1, () );
+	push @permutations, [ $extracted, @$_ ]
+	    for permute( [ @others ] );
+    }
+    return @permutations;
+}
+
+sub sum_of_min_of_pairs( @a ) {
+    return undef
+	unless @a % 2 == 0;
+    return
+	sum( map $_ % 2 == 0 ? min( $a[$_], $a[ $_ + 1 ] ) : 0, 0 .. $#a - 1 );
+}
+
+sub max_of_sums( @a ) {
+    return undef
+	unless @a % 2 == 0;
+    return 
+	max( map sum_of_min_of_pairs( @$_ ), permute( [ @a ] ) );
+}
+
+
+use Test::More;
+
+my @tests = (
+    [ [],              undef ],
+    [ [ 11 ],          undef ],
+    [ [ 11,12 ],       11    ],
+    [ [ 1,2,3,4,5,6 ], 9     ],
+    [ [ 1,2,3,4 ],     4     ],
+    [ [ 0,2,1,3 ],     2     ],
+);
+
+is max_of_sums( @{$_->[0]} ), $_->[1],
+    "max_of_sums( @{$_->[0]} ) == " . ( $_->[1] // "undef" )
+    for @tests;
+
+done_testing;
+
+__END__
+
+use v5.10;
+
+# For testing:
+for ( @tests ) {
+    say "Permutations of @{$_->[0]}:";
+    my @permutations = permute( [ @{$_->[0]} ] );
+    say "    @{$_}"
+	for @permutations;
+}