Perl Weekly Challenge: Week 322
Challenge 1:
String Format
You are given a string and a positive integer.
Write a script to format the string, removing any dashes, in groups of size given by the integer. The first group can be smaller than the integer but should have at least one character. Groups should be separated by dashes.
Example 1
Input: $str = "ABC-D-E-F", $i = 3
Output: "ABC-DEF"
Example 2
Input: $str = "A-BC-D-E", $i = 2
Output: "A-BC-DE"
Example 3
Input: $str = "-A-B-CD-E", $i = 4
Output: "A-BCDE"
Perl first.
The first step is to get rid of the dashes which we do with a simple regular expression.
$str =~ s/-//g;
We will need to know the position in the string at which each group starts. Initially, this will be the start of the string i.e. character 0.
my $pos = 0;
We will also need to know how long the string is which we can find with length().
my $len = length $str;
For some reason I decided to call the list of groups found @segments. The first group (or segment) is special because
it may be less than $i is $len is not an even multiple of $i. So it's length will actually be $len % $1. This value
will be 0 In the case that $len actually is an even multiple of $1 as in example 1. In that case we explicitly set @segments
to () otherwise we will get an unsightly extra dash in the output. (i.e. -ABC-DEF instead of ABC-DEF.)
my @segments = substr($str, $pos, $len % $i) || ();
We then advance $pos by the length of the first segment.
$pos += $len % $i;
We know the rest of the segments are going to be $i character long so as long as $pos is less than $len...
while ($pos < $len) {
...We add a segment to the list...
push @segments, (substr($str, $pos, $i));
...and advance $pos by $i.
$pos += $i;
}
Finally, we readd dashes between all the segments and print the result.
say join q{-}, @segments;
In Raku, $str.comb($1) could have eliminated a lot of actual code but if a string does evenly split into groups, .comb() leaves
the remainder at the end of the list of groups whereas we want it at the beginning. So we have to follow the same method as our
Perl version instead.
Another difference is that, function parameters being immutable, we have to operate on a copy of $str I called $dashless instead.
my $dashless = $str.subst(q{-}, :g);
my $pos = 0;
my $len = $dashless.chars;
my @segments = $dashless.substr($pos, $len % $i) || ();
$pos += $len % $i;
while $pos < $len {
@segments.push($dashless.substr($pos, $i));
$pos += $i;
}
@segments.join(q{-}).say;
Challenge 2:
Rank Array
You are given an array of integers.
Write a script to return an array of the ranks of each element: the lowest value has rank 1, next lowest rank 2, etc. If two elements are the same then they share the same rank.
Example 1
Input: @ints = (55, 22, 44, 33)
Output: (4, 1, 3, 2)
Example 2
Input: @ints = (10, 10, 10)
Output: (1, 1, 1)
Example 3
Input: @ints = (5, 1, 1, 4, 3)
Output: (4, 1, 1, 3, 2)
We create a Hash to map the integers to their ranks.
my %ranked;
The initial rank is 1 not 0 as we are normally accustomed to.
my $rank = 1;
Now for each integer sorted in ascending numeric order...
for @ints.sort({$^a <=> $^b}) -> $int {
..we make it a key in %ranked with $rank as its' value. Then if the key did not previously exist, (i.e if this is the
first time we have seen this integer,) $rank is incremented. If the integer was a duplicate, nothing needs to be added to
%ranked.
%ranked{$int} //= $rank++;
}
Finally, we .map() the ranks to their respective integers (in the original order this time) and print them. The rest of the
code on this line is just to make the output format the same as in the examples.
say q{(}, @ints.map({ %ranked{$_} }).join(q{, }), q{)};
The Perl version works the same as in Raku.
my %ranked;
my $rank = 1;
for my $int (sort {$a <=> $b} @ints) {
$ranked{$int} //= $rank++;
}
say q{(}, (join q{, }, map { $ranked{$_} } @ints), q{)};