Merge pull request #10304 from MatthiasMuth/muthm-274

Challenge 274 Task 1 and 2 solutions in Perl by Matthias Muth

4 files changed, 329 insertions, 103 deletions

diff --git a/challenge-274/matthias-muth/README.md b/challenge-274/matthias-muth/README.md
index 2ac802b1c1..3149bbacb6 100644
--- a/challenge-274/matthias-muth/README.md
+++ b/challenge-274/matthias-muth/README.md
@@ -1,142 +1,234 @@
-# Percentages and the 'BnoA' Regex
-
-**Challenge 273 solutions in Perl by Matthias Muth**
-
-## Task 1: Percentage of Character
-
-> You are given a string, \$str and a character \$char.<br/>
-> Write a script to return the percentage, nearest whole, of given character in the given string.<br/>
-> <br/>
+# These busses got class-maa!
+
+**Challenge 274 solutions in Perl by Matthias Muth**
+
+## Task 1: Goat Latin
+
+> You are given a sentence, \$sentance [sic!].<br/>
+> Write a script to convert the given sentence to Goat Latin, a made up language similar to Pig Latin.<br/>
+> Rules for Goat Latin:<br/>
+>
+> 1) If a word begins with a vowel ("a", "e", "i", "o", "u"), append<br/>
+>    "ma" to the end of the word.<br/>
+> 2) If a word begins with consonant i.e. not a vowel, remove first<br/>
+>    letter and append it to the end then add "ma".<br/>
+> 3) Add letter "a" to the end of first word in the sentence, "aa" to<br/>
+>    the second word, etc etc.
+> 
 > Example 1<br/>
-> Input: \$str = "perl",  \$char = "e"<br/>
-> Output: 25<br/>
+> Input: \$sentence = "I love Perl"<br/>
+> Output: "Imaa ovelmaaa erlPmaaaa"<br/>
 > <br/>
 > Example 2<br/>
-> Input: \$str = "java",  \$char = "a"<br/>
-> Output: 50<br/>
+> Input: \$sentence = "Perl and Raku are friends"<br/>
+> Output: "erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa"<br/>
 > <br/>
 > Example 3<br/>
-> Input: \$str = "python", \$char = "m"<br/>
-> Output: 0<br/>
-> <br/>
-> Example 4<br/>
-> Input: \$str = "ada", \$char = "a"<br/>
-> Output: 67<br/>
-> <br/>
-> Example 5<br/>
-> Input: \$str = "ballerina", \$char = "l"<br/>
-> Output: 22<br/>
-> <br/>
-> Example 6<br/>
-> Input: \$str = "analitik", \$char = "k"<br/>
-> Output: 13<br/>
-
-We need the number of times that the `$char` character appears in the `$str` string.
-So let's count character frequencies. Just like we always do:
+> Input: \$sentence = "The Weekly Challenge"<br/>
+> Output: "heTmaa eeklyWmaaa hallengeCmaaaa"<br/>
+
+Again, Perl regular expressions come to help.<br/>
+Let's construct the result 'on the fly':
+
+* We `split` the sentence into words.
+* For each word,
+  we use a regular expression to separate the first letter from the rest,
+  and to distinguish between a vowel as the first letter or a consonant
+  (actually, anything else than a vowel).<br/>
+  We use captures for anything we need later.<br/>
+  I first tried using named captures,
+  but for the simple case that we have here,
+  I found the result more readable with just `$1`, `$2`, `$3`.
+* For the suffix, we declare a lexical variable `$suffix`  beforehand, initializing it with "ma".<br/>We will add another `"a"` within every iteration.
+* Constructing the resulting word is simple then:<br/>
+  Depending on whether we found a vowel (which means that the `$1` capture is non-empty, we use the original word or a flipped version of it (using the `$2` and `$3` captures).<br/>
+  Then we append the suffix, after having appended the additional `"a"` to it.
+
+The whole Goat Latin translator looks like this:
 
 ```perl
-my %freq;
-++$freq{$_}
-    for split "", $str;
+use v5.36;
+
+sub goat_latin( $sentence ) {
+    my $suffix = "ma";
+    return join " ",
+        map {
+            /^ (?: ([aeiou]) | (\w) ) (.*) /xi;
+            $suffix .= "a";
+            ( $1 ? $_ : "$3$2" ) . $suffix;
+        } split " ", $sentence;
+}
 ```
 
-The percentage that we need is the number of `$char` characters
-divided by the total number of characters in `$str`.
-We need to be careful about the character not being present at all,
-in which case `$freq{ $char }` is `undef`.
-I guess every Perl programmer likes Perl's 'Logical Defined-Or' operator!  :-) 
+## Task 2: Bus Route
 
- ```perl
- ( $freq{ $char } // 0 ) / length( $str )
- ```
+> Several bus routes start from a bus stop near my home, and go to the same stop in town. They each run to a set timetable, but they take different times to get into town.<br/>
+> Write a script to find the times - if any - I should let one bus leave and catch a strictly later one in order to get into town strictly sooner.<br/>
+> An input timetable consists of the service interval, the offset within the hour, and the duration of the trip.<br/>
+> <br/>
+> Example 1<br/>
+> Input: [ [12, 11, 41], [15, 5, 35] ]<br/>
+> Output: [36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47]<br/>
+> Route 1 leaves every 12 minutes, starting at 11 minutes past the hour (so 11, 23, ...) and takes 41 minutes. Route 2 leaves every 15 minutes, starting at 5 minutes past (5, 20, ...) and takes 35 minutes.<br/>
+> At 45 minutes past the hour I could take the route 1 bus at 47 past the hour, arriving at 28 minutes past the following hour, but if I wait for the route 2 bus at 50 past I will get to town sooner, at 25 minutes past the next hour.<br/>
+> <br/>
+> Example 2<br/>
+> Input: [ [[12, 3, 41], [15, 9, 35], [30, 5, 25] ]<br/>
+> Output: [ 0, 1, 2, 3, 25, 26, 27, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 55, 56, 57, 58, 59 ]<br/>
 
-For rounding towards the nearest integer, there are at least these three ways to go:
+#### Object-oriented approach, using Perl `class`
 
-- `use POSIX qw( round );`
+For every minute past the hour (`0..59`),
+we will need know for any bus route when is its next departure time,
+and what will be our arrival time if we take that bus.
+We need this information to decide which bus is the 'next bus',
+and then check 'later buses' for possibly to arrive earlier.
 
-  Loading the `POSIX` module seems like a big overhead
-  for just rounding a floating point number.<br/>
-  So let's look for something else.
+So what if we made every bus route an object,
+with methods like `next_departure( $now )` and `next_arrival( $now )`,
+where we can put in every minute we want to check as a parameter?
 
-- `printf( "%.0f", <number> )`
+What a great way to demonstrate Perl's quite recent new `class` feature!<br/>
+(... which has been out for over a year now, happy anniversary! Love to see it growing!)
 
-  This is the solution that is suggested by the [Perl FAQ](https://perldoc.perl.org/perlfaq4#Does-Perl-have-a-round()-function%3F-What-about-ceil()-and-floor()%3F-Trig-functions%3F).<br/>
-  Looks much better, but there's still a lot of work behind the scenes
-  for a simple operation on a number.<br/>
-  I would not use it if performance is an issue.
+The most difficult thing to compute is the next departure time.
+But it is not too difficult if we first compute the *waiting time* until the bus's next departure.
 
-- `int( <number> + 0.5 )`
+When we miss a bus, the time since its previous departure is
+```perl
+        ( $now - $offset ) % $frequency
+```
+For the waiting time until the *next* departure, we simply turn things around:
+```perl
+    method waiting_time( $now ) {
+        return ( $offset - $now ) % $frequency;
+    }
+```
+The term `( $offset - $now )` can become negative
+(it regularly is after the first departure),
+but the `%` result is correct even for negative numbers.
 
-  Very simple, very basic. This is the rounding I got taught in school.<br/>
-  It's my favorite solution *but only if* it is not for any financial or banking application.
-  Check in the [Perl FAQ](https://perldoc.perl.org/perlfaq4#Does-Perl-have-a-round()-function%3F-What-about-ceil()-and-floor()%3F-Trig-functions%3F) again to see why.
+Given the `waiting_time` method, the rest of the `BusRoute` class is simple.<br/>
+The next departure will be `$now` plus the waiting time,
+and the next arrival time is the next departure time plus the travel duration.
 
-Putting it all together:
+So here is the `BusRoute` class definition.<br/>
+I added a `as_string` method to get a textual self-description for `BusRoute` objects,
+to make it easy to produce tracing or debugging output.<br/>
+I also used an override for the string conversion of the object.
+This way, we can directly use object variables in a double-quoted string
+to get their self-description on output. 
 
 ```perl
-use v5.36;
-
-sub percentage_of_character( $str, $char ) {
-    my %freq;
-    ++$freq{$_}
-        for split "", $str;
-    return int( 100 * ( $freq{$char} // 0 ) / length( $str ) + 0.5 );
+use v5.38;
+use feature 'class';
+no warnings 'experimental::class';
+
+class BusRoute {
+    field $frequency :param;
+    field $offset    :param;
+    field $duration  :param;
+
+    method waiting_time( $now ) {
+        return ( $offset - $now ) % $frequency;
+    }
+
+    method next_departure( $now ) {
+        return $now + $self->waiting_time( $now );
+    }
+
+    method next_arrival( $now ) {
+        return $self->next_departure( $now ) + $duration;
+    }
+
+    method as_string( @args ) {
+        return ref( $self ) . "($frequency,$offset,$duration)";
+    }
+    use overload '""' => \&as_string;
 }
 ```
 
-## Task 2: B After A
+#### Solving the task
+##### Initializing the `BusRoute` objects
 
-> You are given a string, \$str.<br/>
-> Write a script to return true if there is at least one b, and no a appears after the first b.<br/>
-> <br/>
-> Example 1<br/>
-> Input: \$str = "aabb"<br/>
-> Output: true<br/>
-> <br/>
-> Example 2<br/>
-> Input: \$str = "abab"<br/>
-> Output: false<br/>
-> <br/>
-> Example 3<br/>
-> Input: \$str = "aaa"<br/>
-> Output: false<br/>
-> <br/>
-> Example 4<br/>
-> Input: \$str = "bbb"<br/>
-> Output: true<br/>
-
-What a great task for demonstrating how simple things can be with regular expressions!
-
-We need at least one `b`:
+Our  input is a list of array references,
+each one containing  *( frequency, offset, duration )* of one bus route.
+To initialize our `BusRoute` objects, we need to send the parameters as a hash,
+like `{ frequency => 12, offset => 11, duration => 41 }`.<br/>
+I find it very convenient to use `mesh` from `List::Util` to create that parameter list:
 
 ```perl
-/b/
+    my @bus_routes =
+        map BusRoute->new(
+            mesh( [ qw( frequency offset duration ) ], $_ )
+        ), $input->@*;
 ```
 
-But we need to make sure it's the *first* `b`.
-So there must be no other `b` before the one we are looking for.<br/>
-Let's use the `x` flag to keep it more readable:
+##### Loop over all minutes
 
-```perl
-/^ [^b]* b /x
-```
+Now we are ready to do the real job.
 
-Next, we need to check that there is no `a` after that `b` until we reach the end of the string.
+For every minute from 0 to 59, we do these four steps:
 
-```perl
-/^ [^b]* b [^a]* $/x
-```
+- Find the **next departure time**.
+
+  No problem, it's the minimum of all `next_departure()` times of all buses.
+
+- Find the '**best next bus arrival time**'.
+
+  Actually there might be several buses leaving at the same time.
+  We surely want to choose the one that also lets us *arrive* as early as possible.<br/>
+  So it's the minimum *arrival* time of all buses
+  whose departure is equal to our 'next departure time'. 
 
-And putting it all together:
+- Find the '**best later bus arrival time**'.
+
+  Very similar, this is the minimum arrival time of all buses
+  whose departure is ('strictly') *later* than our 'next departure time'.<br/>
+  There might be no 'later' bus at all,
+  if *all* buses happen to have their next departure
+  at the 'next departure time'.
+
+- Decide.
+
+  If there is a 'best later bus arrival time' at all,
+  and it is earlier than the 'best next bus arrival time',
+  we include the current minute in the result set.
+
+So here is the whole implementation.<br/>I have removed comments, because I described everything above.
+I hope it's still understandable.<br/>
+The files in GitHub contain comments, and tracing and debugging output. 
 
 ```perl
 use v5.36;
 
-sub b_after_a( $str ) {
-    return $str =~ /^ [^b]* b [^a]* $/x;
+use List::Util qw( mesh min );
+use BusRoute;
+
+sub bus_route( $input ) {
+    my @bus_routes =
+        map BusRoute->new(
+            mesh( [ qw( frequency offset duration ) ], $_ )
+        ), $input->@*;
+
+    my @results = ();
+    for my $now ( 0..59 ) {
+        my $next_departure = min( map $_->next_departure( $now ), @bus_routes );
+        my $best_next_bus_arrival = min(
+            map $_->next_arrival( $now ),
+                grep $_->next_departure( $now ) == $next_departure,
+                    @bus_routes );
+        my $best_later_bus_arrival = min(
+            map $_->next_arrival( $now ),
+                grep $_->next_departure( $now ) > $next_departure,
+                    @bus_routes );
+        push @results, $now
+            if defined $best_later_bus_arrival
+                && $best_later_bus_arrival < $best_next_bus_arrival;
+    }
+    return \@results;
 }
 ```
 
-That's all we need!
-
-#### **Thank you for the challenge!**
+#### **Thank you for Perl 'class'!**
+#### **And thank you for the challenge!**
diff --git a/challenge-274/matthias-muth/blog.txt b/challenge-274/matthias-muth/blog.txt
new file mode 100644
index 0000000000..c69e75861b
--- /dev/null
+++ b/challenge-274/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-274/challenge-274/matthias-muth#readme
diff --git a/challenge-274/matthias-muth/perl/ch-1.pl b/challenge-274/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..25a34fb88e
--- /dev/null
+++ b/challenge-274/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 274 Task 1: Goat Latin
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+sub goat_latin_1( $sentence ) {
+    my @results;
+    my $maa = "maa";
+    for ( split " ", $sentence ) {
+	/^(?: (?<vowel>[aeiou]) | (?<cons>\w) ) (?<rest>.*)/xi;
+	push @results, ( $+{cons} ? "$+{rest}$+{cons}" : $_ ) . $maa;
+	$maa .= "a";
+    }
+    return join " ", @results;
+}
+
+sub goat_latin( $sentence ) {
+    my $suffix = "ma";
+    return join " ",
+        map {
+            /^ (?: ([aeiou]) | (\w) ) (.*) /xi;
+            $suffix .= "a";
+            ( $1 ? $_ : "$3$2" ) . $suffix;
+        } split " ", $sentence;
+}
+
+use Test2::V0 qw( -no_srand );
+is goat_latin( "I love Perl" ), "Imaa ovelmaaa erlPmaaaa",
+    'Example 1: goat_latin( "I love Perl" ) == "Imaa ovelmaaa erlPmaaaa"';
+is goat_latin( "Perl and Raku are friends" ), "erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa",
+    'Example 2: goat_latin( "Perl and Raku are friends" ) == "erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa"';
+is goat_latin( "The Weekly Challenge" ), "heTmaa eeklyWmaaa hallengeCmaaaa",
+    'Example 3: goat_latin( "The Weekly Challenge" ) == "heTmaa eeklyWmaaa hallengeCmaaaa"';
+done_testing;
diff --git a/challenge-274/matthias-muth/perl/ch-2.pl b/challenge-274/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..e3f52feffc
--- /dev/null
+++ b/challenge-274/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 274 Task 2: Bus Route
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.38;
+use feature 'class';
+no warnings 'experimental::class';
+
+class BusRoute {
+    field $frequency :param;
+    field $offset    :param;
+    field $duration  :param;
+
+    method waiting_time( $now ) {
+        return ( $offset - $now ) % $frequency;
+    }
+
+    method next_departure( $now ) {
+        return $now + $self->waiting_time( $now );
+    }
+
+    method next_arrival( $now ) {
+        return $self->next_departure( $now ) + $duration;
+    }
+
+    method as_string( @args ) {
+        return ref( $self ) . "($frequency,$offset,$duration)";
+    }
+    use overload '""' => \&as_string;
+}
+
+our $verbose = 1;
+sub vsay { say @_ if $verbose }
+
+use List::Util qw( mesh min );
+
+sub bus_route( $input ) {
+    my @bus_routes =
+        map BusRoute->new(
+            mesh( [ qw( frequency offset duration ) ], $_ )
+        ), $input->@*;
+
+    my @results = ();
+    for my $now ( 0..59 ) {
+        vsay "$now:";
+        vsay "    ", join " ",
+            $_,
+            "next departure", $_->next_departure( $now ),
+            "next arrival",   $_->next_arrival( $now )
+            for @bus_routes;
+
+        # Get the next possible departure time.
+        my $next_departure = min( map $_->next_departure( $now ), @bus_routes );
+
+        # Of all the busses leaving at that time (there might be several of
+        # them), we choose the one with the earliest arrival time.
+        my $best_next_bus_arrival = min(
+            map $_->next_arrival( $now ),
+                grep $_->next_departure( $now ) == $next_departure,
+                    @bus_routes );
+
+        # Now find the best arrival time of any *later* bus.
+        # Note that there might not be a 'later' bus if all 'next' busses leave
+        # at the same time.
+        my $best_later_bus_arrival = min(
+            map $_->next_arrival( $now ),
+                grep $_->next_departure( $now ) > $next_departure,
+                    @bus_routes );
+        vsay "    best next bus arrival: $best_next_bus_arrival";
+        vsay "    best later bus arrival: ", $best_later_bus_arrival // "undef";
+
+        # Add the current minute to the results if the later bus's arrival is
+        # earlier than the best next bus's one.
+        push @results, $now
+            if defined $best_later_bus_arrival
+                && $best_later_bus_arrival < $best_next_bus_arrival;
+    }
+    return \@results;
+}
+
+use Test2::V0 qw( -no_srand );
+is bus_route( [[12, 11, 41], [15, 5, 35]] ), [36 .. 47],
+    'Example 1: bus_route( [[12, 11, 41], [15, 5, 35]] ) == [36 .. 47]';
+is bus_route( [[12, 3, 41], [15, 9, 35], [30, 5, 25]] ), [0 .. 3, 25, 26, 27, 40 .. 51, 55 .. 59],
+    'Example 2: bus_route( [[12, 3, 41], [15, 9, 35], [30, 5, 25]] ) == [0 .. 3, 25, 26, 27, 40 .. 51, 55 .. 59]';
+done_testing;