Merge pull request #10286 from jacoby/master

DAJ 274

2 files changed, 128 insertions, 0 deletions

diff --git a/challenge-274/dave-jacoby/perl/ch-1.pl b/challenge-274/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..5e0c4d3d64
--- /dev/null
+++ b/challenge-274/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ bitwise fc postderef say signatures state };
+
+use List::Util qw{max};
+
+my @examples = (
+
+    "I love Perl",
+    "Perl and Raku are friends",
+    "The Weekly Challenge",
+);
+
+for my $example (@examples) {
+    my $output = goat_latin($example);
+    say <<"END";
+    Input:  \$sentence = "$example"
+    Output: "$output"
+END
+}
+
+sub goat_latin ($sentence) {
+    my @output;
+    my @words  = split /\W/, $sentence;
+    my @vowels = qw{ a e i o u };
+    my $c      = 0;
+    for my $word (@words) {
+        my $newword;
+        $c++;
+        my $first_letter = substr $word, 0, 1;
+        if ( grep { /$first_letter/mix } @vowels ) {
+            $newword = $word;
+        }
+        else {
+            $newword = $word;
+            substr( $newword, 0, 1 ) = '';
+            $newword .= $first_letter;
+        }
+        $newword .= 'ma';
+        $newword .= 'a' x $c;
+        push @output, $newword;
+    }
+    return join ' ', @output;
+}
diff --git a/challenge-274/dave-jacoby/perl/ch-2.pl b/challenge-274/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..14102b7c8a
--- /dev/null
+++ b/challenge-274/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,82 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ fc say postderef signatures state };
+
+use List::Util qw{ first };
+use JSON;
+
+my $j    = JSON->new->canonical->space_after;
+my @examples = (
+
+    [ [ 12, 11, 41 ], [ 15, 5, 35 ] ],
+    [ [ 12, 3,  41 ], [ 15, 9, 35 ], [ 30, 5, 25 ] ],
+);
+
+for my $example (@examples) {
+    my $routes = best_route( $example->@* );
+    my $input  = $j->encode($example);
+    my $output = $j->encode($routes);
+
+    say <<"END";
+Input:  $input
+Output: $output
+END
+}
+
+sub best_route (@routes) {
+    my @starts;
+    my @route_ids;
+    my @timetable;
+
+    my $r = 0;
+    for my $route (@routes) {
+        $r++;
+        push @route_ids, $r;
+        my ( $interval, $start, $duration ) = $route->@*;
+        my $i     = 0;
+        my $stime = 0;
+        while ( $stime < 60 ) {
+            $stime = $start + ( $interval * $i );
+            my $etime = $stime + $duration;
+            my $bus   = {
+                route => $r,
+                home  => $stime,
+                dest  => $etime,
+            };
+            push @timetable, $bus;
+            $i++;
+        }
+    }
+
+    @timetable = sort { $a->{home} <=> $b->{home} } @timetable;
+
+    for my $t ( 0 .. 59 ) {
+        my @next;
+        for my $r (@route_ids) {
+            my ($next) = grep { $t <= $_->{home} }
+                grep { $_->{route} == $r } @timetable;
+            push @next, $next;
+        }
+
+        my ($next_bus) =
+            sort { $a->{home} <=> $b->{home} } @next;
+        my ($best_bus) =
+            sort { $a->{dest} <=> $b->{dest} } @next;
+
+        my $next_bus_route = $next_bus->{route};
+        my $best_bus_route = $best_bus->{route};
+
+        my $next_bus_home = $next_bus->{home};
+        my $best_bus_home = $best_bus->{home};
+
+        my $same = 0;
+        if ( $next_bus_route == $best_bus_route ) { $same = 1 }
+        if ( $next_bus_home == $best_bus_home )   { $same = 1 }
+
+        push @starts, int $t if !$same;
+    }
+
+    return \@starts;
+}