diff options
| -rwxr-xr-x | challenge-274/peter-meszaros/perl/ch-1.pl | 72 | ||||
| -rwxr-xr-x | challenge-274/peter-meszaros/perl/ch-2.pl | 85 |
2 files changed, 157 insertions, 0 deletions
diff --git a/challenge-274/peter-meszaros/perl/ch-1.pl b/challenge-274/peter-meszaros/perl/ch-1.pl new file mode 100755 index 0000000000..fd65a5f31c --- /dev/null +++ b/challenge-274/peter-meszaros/perl/ch-1.pl @@ -0,0 +1,72 @@ +#!/usr/bin/env perl +# +=head1 Task 1: Goat Latin + +You are given a sentence, $sentance. + +Write a script to convert the given sentence to Goat Latin, a made up language +similar to Pig Latin. + +Rules for Goat Latin: + +1) If a word begins with a vowel ("a", "e", "i", "o", "u"), append +"ma" to the end of the word. + +2) If a word begins with consonant i.e. not a vowel, remove first +letter and append it to the end then add "ma". + +3) Add letter "a" to the end of first word in the sentence, "aa" to +the second word, etc etc. + +=head2 Example 1 + + Input: $sentence = "I love Perl" + Output: "Imaa ovelmaaa erlPmaaaa" + +=head2 Example 2 + + Input: $sentence = "Perl and Raku are friends" + Output: "erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa" + +=head2 Example 3 + + Input: $sentence = "The Weekly Challenge" + Output: "heTmaa eeklyWmaaa hallengeCmaaaa" + +=cut + +use strict; +use warnings; +use Test2::V0 -no_srand => 1; +use Data::Dumper; + +my $cases = [ + ["I love Perl", + "Imaa ovelmaaa erlPmaaaa", "Example 1"], + ["Perl and Raku are friends", + "erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa", "Example 2"], + ["The Weekly Challenge", + "heTmaa eeklyWmaaa hallengeCmaaaa", "Example 3"], +]; + +sub goat_latin +{ + my $s = shift; + + my $n = 1; + my @s; + for my $w (split / /, $s) { + unless ($w =~ /^[aeiou]/i) { + $w = substr($w, 1) . substr($w, 0, 1); + } + push @s, $w . 'ma' . ('a' x $n++); + } + return join(' ', @s); +} + +for (@$cases) { + is(goat_latin($_->[0]), $_->[1], $_->[2]); +} +done_testing(); + +exit 0; diff --git a/challenge-274/peter-meszaros/perl/ch-2.pl b/challenge-274/peter-meszaros/perl/ch-2.pl new file mode 100755 index 0000000000..76baccc78a --- /dev/null +++ b/challenge-274/peter-meszaros/perl/ch-2.pl @@ -0,0 +1,85 @@ +#!/usr/bin/env perl +# +=head1 Task 2: Bus Route + +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. + +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. + +An input timetable consists of the service interval, the offset within the +hour, and the duration of the trip. + +=head2 Example 1 + + Input: [ [12, 11, 41], [15, 5, 35] ] + Output: [36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47] + +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. + +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. + +=head2 Example 2 + + Input: [ [12, 3, 41], [15, 9, 35], [30, 5, 25] ] + 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 ] + +=cut + +use strict; +use warnings; +use Test2::V0 -no_srand => 1; +use Data::Dumper; + +my $cases = [ + [[[12, 11, 41], + [15, 5, 35]], + [36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47] + ], + [[[12, 3, 41], + [15, 9, 35], + [30, 5, 25]], + [0, 1, 2, 3, 25, 26, 27, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, + 51, 55, 56, 57, 58, 59] + ], +]; + +sub bus_route +{ + my $routes = shift; + + my %tt; + for my $r (@$routes) { + my ($cycle, $start, $duration) = @$r; + while (1) { + if (!exists($tt{$start}) or ($duration + $start) < $tt{$start}) { + $tt{$start} = ($start + $duration); + } + last if $start > 60; + $start += $cycle; + } + } + + my @mins; + my @deptmins = sort {$a <=> $b} keys %tt; + for my $i (0..59) { + shift @deptmins if $i > $deptmins[0]; + push @mins, $i if $tt{$deptmins[1]} < $tt{$deptmins[0]}; + } + return \@mins; +} + +for (@$cases) { + is(bus_route($_->[0]), $_->[1], $_->[2]); +} +done_testing(); + +exit 0; + |