Perl Weekly Challenge 248: Shortest Distance
These are some answers to the Week 248, Task 1, of the Perl Weekly Challenge organized by Mohammad S. Anwar.
Spoiler Alert: This weekly challenge deadline is due in a few days from now (on December 24, 2023 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
Task 1: Shortest Distance
You are given a string and a character in the given string.
Write a script to return an array of integers of size same as length of the given string such that:
distance[i] is the distance from index i to the closest occurrence of the given character in the given string.
The distance between two indices i
and j
is abs(i - j)
.
Example 1
Input: $str = "loveleetcode", $char = "e"
Output: (3,2,1,0,1,0,0,1,2,2,1,0)
The character 'e' appears at indices 3, 5, 6, and 11 (0-indexed).
The closest occurrence of 'e' for index 0 is at index 3, so the distance is abs(0 - 3) = 3.
The closest occurrence of 'e' for index 1 is at index 3, so the distance is abs(1 - 3) = 2.
For index 4, there is a tie between the 'e' at index 3 and the 'e' at index 5,
but the distance is still the same: abs(4 - 3) == abs(4 - 5) = 1.
The closest occurrence of 'e' for index 8 is at index 6, so the distance is abs(8 - 6) = 2.
Example 2
Input: $str = "aaab", $char = "b"
Output: (3,2,1,0)
Note that there is the special case of a tie (index 4 in the first example above), but we don’t need to worry about that: if the two distances are equal, we simply use any of them.
Shortest Distance in Raku
From a given position in the input string, we use the built-in index and rindex routines to find, respectively, the next and the previous occurrence of the searched letter, and use the occurrence with the smallest distance. If any of the two occurrences is not found (undefined), we simply use the distance of the other.
sub shortest-distance ($char, $str) {
my @result;
for 0..^$str.chars -> $i {
my $next = $str.index($char, $i);
my $prev = $str.rindex($char, $i);
push @result, abs($i - $next) and next
unless defined $prev;
push @result, abs($i - $prev) and next
unless defined $next;
my $dist = abs($i - $next) < abs($i - $prev) ??
abs($i - $next) !! abs($i - $prev);
push @result, $dist;
}
return "@result[]";
}
my @tests = { str => "loveleetcode", char => "e" },
{ str => "aaab", char => "b"};
for @tests -> %test {
printf "%-1s - %-15s => ", %test{"char"}, %test{"str"};
say shortest-distance %test{"char"}, %test{"str"};
}
This program displays the following output:
$ raku ./shortest-distance.raku
e - loveleetcode => 3 2 1 0 1 0 0 1 2 2 1 0
b - aaab => 3 2 1 0
Shortest Distance in Perl
This program is a port to Perl of the above Raku program. It also uses the built-in index
and rindex
functions. Asides from minor syntax changes, the only significant difference is that the Perl index
and rindex
functions return -1
(instead of an undefined value in Raku) when they found no match, so we test for a possible negative value. .
use strict;
use warnings;
use feature 'say';
sub shortest_distance {
my ($char, $str) = @_;
my @result;
my $max_idx = length($str) - 1;
for my $i (0..$max_idx) {
my $next = index ($str, $char, $i);
my $prev = rindex( $str, $char, $i);
push @result, abs($i - $next) and next if $prev < 0;
push @result, abs($i - $prev) and next if $next < 0;
my $dist = abs($i - $next) < abs($i - $prev) ?
abs($i - $next) : abs($i - $prev);
push @result, $dist;
}
return "@result";
}
my @tests = ( { str => "loveleetcode", char => "e" },
{ str => "aaab", char => "b" } );
for my $t (@tests) {
printf "%-1s - %-15s => ", $t->{"char"}, $t->{"str"};
say shortest_distance $t->{"char"}, $t->{"str"};
}
This program displays the following output:
$ perl ./shortest-distance.pl
e - loveleetcode => 3 2 1 0 1 0 0 1 2 2 1 0
b - aaab => 3 2 1 0
Wrapping up
Seasons greeting to everyone. The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on December 31, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.
Leave a comment