Perl Weekly Challenge 274.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 274.
Task 1: Goat Latin
Submitted by: Mohammad Sajid Anwar
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.
Example 1
Input: $sentence = "I love Perl"
Output: "Imaa ovelmaaa erlPmaaaa"
Example 2
Input: $sentence = "Perl and Raku are friends"
Output: "erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa"
Example 3
Input: $sentence = "The Weekly Challenge"
Output: "heTmaa eeklyWmaaa hallengeCmaaaa"
It is not clear what to do if a word begins with a character that is
not a consonant or a vowel. I assume below that in that case, I simply
append ‘ma’ and the appropriate number of trailing ‘a’s, as in the
case of a vowel. I use a regular expression to match a consonant,
i.e., a letter in the range a-z that is not a vowel. To that end I use
lookahead. I use s to transpose the initial consonant with the rest
of the word. In any case, I append ‘ma’ and I use a counter to append
the appropriate number of ‘a’s. The code fits a one-liner.
Example 1:
perl -E '
@i=@ARGV;for(@ARGV){s/^(?=[a-z])([^aeiou])(.*)/$2$1/i;$_.="maa"."a"x$n++;push @o,$_;} say "@i -> @o"
' I love Perl
Results:
I love Perl -> Imaa ovelmaaa erlPmaaaa
Example 2:
perl -E '
@i=@ARGV;for(@ARGV){s/^(?=[a-z])([^aeiou])(.*)/$2$1/i;$_.="maa"."a"x$n++;push @o,$_;} say "@i -> @o"
' Perl and Raku are friends
Results:
Perl and Raku are friends -> erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa
Example 3:
perl -E '
@i=@ARGV;for(@ARGV){s/^(?=[a-z])([^aeiou])(.*)/$2$1/i;$_.="maa"."a"x$n++;push @o,$_;} say "@i -> @o"
' The Weekly Challenge
Results:
The Weekly Challenge -> heTmaa eeklyWmaaa hallengeCmaaaa
The full code is similar:
1 # Perl weekly challenge 274
2 # Task 1: Goat Latin
3 #
4 # See https://wlmb.github.io/2024/06/17/PWC274/#task-1-goat-latin
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 S1 S2...
8 to rewrite sentences S1 S2... in Goat Latin
9 FIN
10 while(@ARGV){
11 my @words=split " ", my $sentence=shift;
12 my $count=1;
13 my @out;
14 for(@words){
15 s/^(?=[a-z])([^aeiou])(.*)/$2$1/i;
16 $_.="ma"."a"x$count++;
17 }
18 say "$sentence -> @words"
19 }
Examples:
./ch-1.pl "I love Perl" "Perl and Raku are friends" "The Weekly Challenge"
Results:
I love Perl -> Imaa ovelmaaa erlPmaaaa
Perl and Raku are friends -> erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa
The Weekly Challenge -> heTmaa eeklyWmaaa hallengeCmaaaa
Task 2: Bus Route
Submitted by: Peter Campbell Smith
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.
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.
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 ]
I use pdl to input the schedules. For each timetable I build an array of bus runs, with a starting time and duration. I sort it according to the starting time. Then I iterate over the runs replacing their duration by the duration of the next bus plus the wait, if it is convenient, and flag the change until no further optimization is possible. Then, I output all the times (with one minute resolution) at which it is preferable to wait than taking the bus. Some care has to be taken and modular arithmetic must be used as time is cyclic.
1 # Perl weekly challenge 274
2 # Task 2: Bus Route
3 #
4 # See https://wlmb.github.io/2024/06/17/PWC274/#task-2-bus-route
5 use v5.36;
6 use PDL;
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S1 S2...
9 to find when it is best to wait for the next bus,
10 where S1, S2... are schedules of the form
11 "[T1 T2...]" and T1, T2... are timetables of the form
12 [F I D] with F the first run of each hour, I the interval
13 between runs and D the duration of each run.
14 FIN
15 for(@ARGV){
16 my @schedule;
17 for(pdl($_)->dog){
18 my ($interval, $start, $duration)=$_->list;
19 die "Interval not submultiple of 60; $interval" if 60%$interval;
20 push @schedule, map {[$start+$interval*$_, $duration,0]}(0..60/$interval-1);
21 }
22 my @sorted=sort{$a->[0]<=>$b->[0] || $a->[1]<=>$b->[1]}@schedule;
23 my $changed=1;
24 while($changed){
25 $changed=0;
26 for(reverse 0..@sorted-1){
27 my @current=$sorted[$_]->@*;
28 my @next=$sorted[($_+1)%@sorted]->@*;
29 my $wait=($next[0]-$current[0])%60+$next[1];
30 next unless $wait<$current[1];
31 ++$changed;
32 $sorted[$_]=[$current[0], $wait, 1];
33 }
34 }
35 my @out;
36 for(0..@sorted-1){
37 my @current=$sorted[$_]->@*;
38 my @next=$sorted[($_+1)%@sorted]->@*;
39 next unless $next[2];
40 my $first=$current[0];
41 my $last=$next[0];
42 $last+=60 if $last<$first;
43 push @out, map{$_%60} $first+1..$last;
44 }
45 say "$_ -> ", pdl(@out);
46 }
Examples:
./ch-2.pl "[ [12 11 41][15 5 35] ]" "[ [12 3 41][15 9 35][30 5 25] ]"
Results:
[ [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] ]
-> [25 26 27 40 41 42 43 44 45 46 47 48 49 50 51 55 56 57 58 59 0 1 2 3]
I compressed the code above into a five-liner, but the resulting code is not too inspiring.
Example 1:
perl -MPDL -E '
for(pdl($p=shift)->dog){($i,$s,$d)=$_->list;push @s,map {[$s+$i*$_,$d,0]}(0..60/$i-1);}
@s=sort{$a->[0]<=>$b->[0]||$a->[1]<=>$b->[1]}@s;$c=1;while($c){$c=0;for(reverse 0..@s-1){
@c=$s[$_]->@*;@n=$s[($_+1)%@s]->@*;$w=($n[0]-$c[0])%60+$n[1];next unless $w<$c[1];++$c;
$s[$_]=[$c[0], $w, 1];}}for(0..@s-1){@c=$s[$_]->@*;@n=$s[($_+1)%@s]->@*;next unless $n[2];$f=$c[0];
$l=$n[0];$l+=60 if $l<$f;push @o, map{$_%60} $f+1..$l;}say "$p -> ", pdl(@o);
' "[ [12 11 41][15 5 35] ]"
Results:
[ [12 11 41][15 5 35] ] -> [36 37 38 39 40 41 42 43 44 45 46 47]
Example 2:
perl -MPDL -E '
for(pdl($p=shift)->dog){($i,$s,$d)=$_->list;push @s,map {[$s+$i*$_,$d,0]}(0..60/$i-1);}
@s=sort{$a->[0]<=>$b->[0]||$a->[1]<=>$b->[1]}@s;$c=1;while($c){$c=0;for(reverse 0..@s-1){
@c=$s[$_]->@*;@n=$s[($_+1)%@s]->@*;$w=($n[0]-$c[0])%60+$n[1];next unless $w<$c[1];++$c;
$s[$_]=[$c[0], $w, 1];}}for(0..@s-1){@c=$s[$_]->@*;@n=$s[($_+1)%@s]->@*;next unless $n[2];$f=$c[0];
$l=$n[0];$l+=60 if $l<$f;push @o, map{$_%60} $f+1..$l;}say "$p -> ", pdl(@o);
' "[ [12 3 41][15 9 35][30 5 25] ]"
Results:
[ [12 3 41][15 9 35][30 5 25] ]
-> [25 26 27 40 41 42 43 44 45 46 47 48 49 50 51 55 56 57 58 59 0 1 2 3]
Written on June 17, 2024