Perl Weekly Challenge: Week 181
Challenge 1:
Sentence Order
You are given a paragraph.
Write a script to order each sentence alphanumerically and print the whole paragraph.
Example
Input:
All he could think about was how it would all end. There was
still a bit of uncertainty in the equation, but the basics
were there for anyone to see. No matter how much he tried to
see the positive, it wasn't anywhere to be seen. The end was
coming and it wasn't going to be pretty.
Ouput:
about All all could end he how it think was would. a anyone
basics bit but equation, for in of see still the the There
there to uncertainty was were. anywhere be he how it matter
much No positive, see seen the to to tried wasn't. and be
coming end going it pretty The to was wasn't.
This week I decided to do the Perl versions first. Rather than read the input text from a file or the standard input stream, I used a here document.
my $text = <<'-TEXT-';
All he could think about was how it would all end. There was
still a bit of uncertainty in the equation, but the basics
were there for anyone to see. No matter how much he tried to
see the positive, it wasn't anywhere to be seen. The end was
coming and it wasn't going to be pretty.
-TEXT-
A little preprocessing has to be done. Newlines have to be converted to spaces and the newline at the end which has just been converted to a space has to be removed altogether.
$text =~ s/\n/ /msgx;
$text =~ s/\ $//msgx;
At this point, the input text is now one long line. Now we reserve some storage for the output text.
my $newtext;
And split the input text on periods to make an array of sentences.
my @sentences = split q{\.}, $text;
For each sentence...
for my $sentence (@sentences) {
...We split it into an array of words. Apparently according to the spec, we need to keep periods and other punctuation so we just use spaces as the separator.
my @words = split /\ +/, $sentence;
We sort the list of words alphanumerically and case-insensitively (by capitalizing each word as we sort it.)
@words = sort { uc $a cmp uc $b } @words;
Then the words are joined back up together with a space and the resulting string is apeended to the output text.
$newtext .= join q{ }, @words;
When the input text was split into sentences, we lost the period at the end of each sentence so it is added back now and also appended to the output text.
$newtext .= q{. };
}
Now we can print out $newtext and we're done. However, in the spec, the output
is shown wrapped; I thought it would be nice to do the same. As luck would have
it, one of the tasks way back in PWC 19 was
to create a word wrap function so I was able to reuse it here without much extra work.
wordWrap($newtext, 60);
I did have to make a couple of changes to wordWrap() so here it is again.
sub wordWrap {
my ($paragraph, $lineWidth) = @_;
my $spaceLeft = $lineWidth + 1;
Originally in the line below, I had used \w and \W which was probably a mistake.
\S and \s give me the proper result.
while ( $paragraph =~ /\G (?<word> \S+)(\s+)? /gcx ) {
my $wordWidth = length $+{word};
if ($wordWidth + 1 > $spaceLeft) {
print "\n";
$spaceLeft = $lineWidth - $wordWidth;
} else {
$spaceLeft -= ($wordWidth + 1);
}
print "$+{word} ";
}
Also, originally I did not print a trailing newline which is needed here.
print "\n";
}
This is the Raku version. The Raku syntax for here documents confused me for a bit but other than that, translation was plain sailing.
my $text = q:to/-TEXT-/;
All he could think about was how it would all end. There was
still a bit of uncertainty in the equation, but the basics
were there for anyone to see. No matter how much he tried to
see the positive, it wasn't anywhere to be seen. The end was
coming and it wasn't going to be pretty.
-TEXT-
$text = $text.subst(/\n/, ' ', :g);
$text = $text.subst(/\n$/);
my $newtext;
my @sentences = $text.split(/\./);
For some reason which I'm not getting, the Raku here document added an extra newline at the end which has to be removed for proper looking output.
@sentences.pop();
for @sentences -> $sentence {
my @words = $sentence.split(/' '+/);
@words = @words.sort({ $^a.uc cmp $^b.uc });
$newtext ~= @words.join(q{ });
$newtext ~= q{. };
}
wordWrap($newtext, 60);
}
This is the Raku version of wordWrap().
sub wordWrap(Str $paragraph, Int $lineWidth) {
my $spaceLeft = $lineWidth + 1;
for $paragraph.words -> $word {
my $wordWidth = $word.chars;
if $wordWidth + 1 > $spaceLeft {
print "\n";
$spaceLeft = $lineWidth - $wordWidth;
} else {
$spaceLeft -= ($wordWidth + 1);
}
print "$word ";
}
print "\n";
}
Challenge 2:
Hot Day
You are given file with daily temperature record in random order.
Write a script to find out days hotter than previous day.
Example
Input File: (temperature.txt)
2022-08-01, 20
2022-08-09, 10
2022-08-03, 19
2022-08-06, 24
2022-08-05, 22
2022-08-10, 28
2022-08-07, 20
2022-08-04, 18
2022-08-08, 21
2022-08-02, 25
Output:
2022-08-02
2022-08-05
2022-08-06
2022-08-08
2022-08-10
We start by following the standard Perl pattern for opening and reading a file.
By undefining the record seperator $RS, the contents can be efficiently slurped
up in one read.
open my $fh, '<', 'temperature.txt' or die "$OS_ERROR\n";
local $RS = undef;
my $data = <$fh>;
close $fh;
Then the contents of the file are split into an array of lines.
my @lines = split /\n/, $data;
A hash is set up to map dates to temperatures and the lines are are parsed to populate the hash.
my %temperatures;
for my $line (@lines) {
chomp $line;
my ($date, $temperature) = split q{, }, $line;
$temperatures{$date} = $temperature;
}
Now we sort the date-temperature hash by date. The temperature on each day is
compared to that on the day before and if it is greater it is output. On the
first day, there is no previous temperature to compare with so it should never
be output. We ensure this by setting the initial value of $previousTemp to an
impossibly high value such as infinity.
my $previousTemp = 'Inf';
for my $k (sort { $a cmp $b } keys %temperatures) {
if ($temperatures{$k} > $previousTemp) {
say $k;
}
The current temperature becomes the next previous temperature.
$previousTemp = $temperatures{$k};
}
This is the Raku version.
my %temperatures;
for 'temperature.txt'.IO.lines -> $line {
chomp $line;
my ($date, $temperature) = split q{, }, $line;
%temperatures{$date} = $temperature;
}
my $previousTemp = ∞;
for %temperatures.keys.sort({ $^a cmp $^b }) -> $k {
if %temperatures{$k} > $previousTemp {
say $k;
}
$previousTemp = %temperatures{$k};
}