aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Köhler <jean-luc@picard.franken.de>2023-03-01 19:38:20 +0100
committerThomas Köhler <jean-luc@picard.franken.de>2023-03-01 19:38:20 +0100
commit0e871ba796fb28927da8e2522284dfcfc332af15 (patch)
tree7918acb40e19200ce0db2e06215586b16864bb42
parent09eef326c170759598ee2d5d35a5aad50be4a11c (diff)
downloadperlweeklychallenge-club-0e871ba796fb28927da8e2522284dfcfc332af15.tar.gz
perlweeklychallenge-club-0e871ba796fb28927da8e2522284dfcfc332af15.tar.bz2
perlweeklychallenge-club-0e871ba796fb28927da8e2522284dfcfc332af15.zip
Add solution for week 206
Signed-off-by: Thomas Köhler <jean-luc@picard.franken.de>
-rw-r--r--challenge-206/jeanluc2020/blog-1.txt1
-rw-r--r--challenge-206/jeanluc2020/blog-2.txt1
-rwxr-xr-xchallenge-206/jeanluc2020/perl/ch-1.pl91
-rwxr-xr-xchallenge-206/jeanluc2020/perl/ch-2.pl98
4 files changed, 191 insertions, 0 deletions
diff --git a/challenge-206/jeanluc2020/blog-1.txt b/challenge-206/jeanluc2020/blog-1.txt
new file mode 100644
index 0000000000..5c8bfae1c7
--- /dev/null
+++ b/challenge-206/jeanluc2020/blog-1.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-206-1.html
diff --git a/challenge-206/jeanluc2020/blog-2.txt b/challenge-206/jeanluc2020/blog-2.txt
new file mode 100644
index 0000000000..a5df38acd6
--- /dev/null
+++ b/challenge-206/jeanluc2020/blog-2.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-206-2.html
diff --git a/challenge-206/jeanluc2020/perl/ch-1.pl b/challenge-206/jeanluc2020/perl/ch-1.pl
new file mode 100755
index 0000000000..bac4231fb9
--- /dev/null
+++ b/challenge-206/jeanluc2020/perl/ch-1.pl
@@ -0,0 +1,91 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-206/#TASK1
+#
+# Task 1: Shortest Time
+# =====================
+#
+# You are given a list of time points, at least 2, in the 24-hour clock format HH:MM.
+#
+# Write a script to find out the shortest time in minutes between any two time points.
+#
+## Example 1
+##
+## Input: @time = ("00:00", "23:55", "20:00")
+## Output: 5
+##
+## Since the difference between "00:00" and "23:55" is the shortest (5 minutes).
+#
+## Example 2
+##
+## Input: @array = ("01:01", "00:50", "00:57")
+## Output: 4
+#
+## Example 3
+##
+## Input: @array = ("10:10", "09:30", "09:00", "09:55")
+## Output: 15
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# Basically we have to walk the array with two variables, and
+# for all combinations of time points calculate the minimum
+# difference (basically from a to b and from b to a for all
+# combinations of two time points, and the minimum of all those
+# values).
+
+use strict;
+use warnings;
+
+shortest_time("00:00", "23:55", "20:00");
+shortest_time("01:01", "00:50", "00:57");
+shortest_time("10:10", "09:30", "09:00", "09:55");
+
+sub shortest_time {
+ my @time_points = @_;
+ die "Not enough timepoints!" unless @time_points > 1;
+ foreach my $t (@time_points) {
+ die "Invalid time format for $t!\n" unless $t =~ m/^\d\d:\d\d/;
+ }
+ print "Input: (" . join(", ", @time_points) . ")\n";
+ my $minimum = 1440; # let's start with 24 hours as the initial value
+ foreach my $first (0..$#time_points) {
+ foreach my $second ($first+1..$#time_points) {
+ my ($A, $B) = ($time_points[$first], $time_points[$second]);
+ # we calculate the diff in both directions and search the
+ # minimum along the way
+ my $diff = time_diff($A, $B);
+ $minimum = $diff if $diff < $minimum;
+ $diff = time_diff($B, $A);
+ $minimum = $diff if $diff < $minimum;
+ }
+ }
+ print "Output: $minimum\n";
+}
+
+sub time_diff {
+ my ($A, $B) = @_;
+ # let's calculate the times as minutes since 00:00
+ my $minutes_a = to_minutes($A);
+ my $minutes_b = to_minutes($B);
+ if($minutes_b >= $minutes_a) {
+ return $minutes_b - $minutes_a;
+ }
+ # the second time point is before the first time point,
+ # so let's calculate the time diff by wrapping around
+ # 00:00 once
+ return 1440 + $minutes_b - $minutes_a;
+}
+
+# helper function to turn a time point into minutes since 00:00
+sub to_minutes {
+ my $time = shift;
+ die "Invalid time format for $time!\n" unless $time =~ m/^\d\d:\d\d/;
+ my ($h, $m) = split /:/, $time;
+ $h =~ s/^0//;
+ $m =~ s/^0//;
+ return $h * 60 + $m;
+}
diff --git a/challenge-206/jeanluc2020/perl/ch-2.pl b/challenge-206/jeanluc2020/perl/ch-2.pl
new file mode 100755
index 0000000000..cdb4b30da3
--- /dev/null
+++ b/challenge-206/jeanluc2020/perl/ch-2.pl
@@ -0,0 +1,98 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-206/#TASK2
+#
+# Task 2: Array Pairings
+# ======================
+#
+# You are given an array of integers having even number of elements..
+#
+# Write a script to find the maximum sum of the minimum of each pairs.
+#
+## Example 1
+##
+## Input: @array = (1,2,3,4)
+## Output: 4
+##
+## Possible Pairings are as below:
+## a) (1,2) and (3,4). So min(1,2) + min(3,4) => 1 + 3 => 4
+## b) (1,3) and (2,4). So min(1,3) + min(2,4) => 1 + 2 => 3
+## c) (1,4) and (2,3). So min(1,4) + min(2,3) => 2 + 1 => 3
+##
+## So the maxium sum is 4.
+#
+## Example 2
+##
+## Input: @array = (0,2,1,3)
+## Output: 2
+##
+## Possible Pairings are as below:
+## a) (0,2) and (1,3). So min(0,2) + min(1,3) => 0 + 1 => 1
+## b) (0,1) and (2,3). So min(0,1) + min(2,3) => 0 + 2 => 2
+## c) (0,3) and (2,1). So min(0,3) + min(2,1) => 0 + 1 => 1
+##
+## So the maximum sum is 2.
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# We could this as follows:
+# - First, we create all possible pairings
+# - Then we calculate the sum of the minimums of each pair for
+# each of the possible pairings
+# - Then we keep the maximum of those sums
+# However, it is more efficient to do this on the go:
+# - Create a recursive function that takes the first element
+# of the array, then for each remaining element:
+# - calculate the minumum of this element and the first one
+# - add the maximum sum of all remaining elements
+
+use strict;
+use warnings;
+
+array_pairings(1,2,3,4);
+array_pairings(0,2,1,3);
+array_pairings(0,2,1,3,6,9);
+
+sub array_pairings {
+ my @array = @_;
+ # Output is here, the calculation happens in an extra function
+ print "Input: (" . join(", ", @array) . ")\n";
+ print "Output: " . max_array_pairings(@array) . "\n";
+}
+
+sub max_array_pairings {
+ my @array = @_;
+ die "Not an even number of elements" if @array % 2;
+ # if the array is empty, we can return 0 and are done
+ return 0 unless @array;
+ my $maximum = 0;
+ # pick the first element of the array for all possible pairings with it
+ my $first = shift @array;
+ foreach my $index (0..$#array) {
+ # for all possible pairings with the first element, calculate the minimum of the pairing
+ # plus the result of the recursive function call
+ my $current = min($first, $array[$index]) + max_array_pairings(@array[0..$index-1], @array[$index+1..$#array]);
+ # if our current result is greater than the maximum so far, we have a new maximum
+ $maximum = $current if $current > $maximum;
+ }
+ return $maximum;
+}
+
+# Helper function to calculate the minimum element of an array
+# Of course we could use
+# use List::Util qw(min);
+# instead, but on the other hand, this is fast to write so let's
+# implement it ourselves :)
+sub min {
+ my @array = @_;
+ die "Can't calculate minimum of empty array!\n" unless @array > 0;
+ my $minimum = $array[0];
+ foreach my $elem (@array) {
+ $minimum = $elem if $elem < $minimum;
+ }
+ return $minimum;
+}
+