Perl Weekly Challenge: Week 362
Challenge 1:
Echo Chamber
You are given a string containing lowercase letters.
Write a script to transform the string based on the index position of each character (starting from 0). For each character at position i, repeat it i + 1 times.
Example 1
Input: "abca"
Output: "abbcccaaaa"
Index 0: "a" -> repeated 1 time -> "a"
Index 1: "b" -> repeated 2 times -> "bb"
Index 2: "c" -> repeated 3 times -> "ccc"
Index 3: "a" -> repeated 4 times -> "aaaa"
Example 2
Input: "xyz"
Output: "xyyzzz"
Index 0: "x" -> "x"
Index 1: "y" -> "yy"
Index 2: "z" -> "zzz"
Example 3
Input: "code"
Output: "coodddeeee"
Index 0: "c" -> "c"
Index 1: "o" -> "oo"
Index 2: "d" -> "ddd"
Index 3: "e" -> "eeee"
Example 4
Input: "hello"
Output: "heelllllllooooo"
Index 0: "h" -> "h"
Index 1: "e" -> "ee"
Index 2: "l" -> "lll"
Index 3: "l" -> "llll"
Index 4: "o" -> "ooooo"
Example 5
Input: "a"
Output: "a"
Index 0: "a" -> "a"
This is yet another problem that can be solved by Perl and Raku in one line.
First we set up a variable that serves as both the (1-based) index into the string and the number of times the particular character has to be duplicated.
We take the input from the first command-line argument which is split into characters
with .comb(). Using .map(), each of these characters is duplicated $i number of
times by the x operator. Then $i is incremented. All these sequences of duplicated
characters are .join()ed back into one string and output with .say().
my $i=1; @*ARGS[0].comb.map({ $_ x $i++ }).join.say
The Perl version works exactly the same way but without Rakus' method chaining, it's a bit harder to read in my opinion.
$i=1; say join q{}, map{ $_ x $i++ } split//, shift
Challenge 2:
Spellbound Sorting
You are given an array of integers.
Write a script to return them in alphabetical order, in any language of your choosing. Default language is English.
Example 1
Input: (6, 7, 8, 9 ,10)
Output: (8, 9, 7, 6, 10)
eight, nine, seven, six, ten
Example 2
Input: (-3, 0, 1000, 99)
Output: (-3, 99, 1000, 0)
minus three, ninety-nine, one thousand, zero
Example 3
Input: (1, 2, 3, 4, 5)
Output: (5, 2, 4, 3, 1) for French language
cinq, deux, quatre, trois, un
Output: (5, 4, 1, 3, 2) for English language
five, four, one, three, two
Example 4
Input: (0, -1, -2, -3, -4)
Output: (-4, -1, -3, -2, 0)
minus four, minus one, minus three, minus two, zero
Example 5
Input: (100, 101, 102)
Output: (100, 101, 102)
one hundred, one hundred and one, one hundred and two
I would like to implement this for Gujarati, my native tongue, and I may do so at some point, but as I am currently a bit pressed for time I only did it for English.
The MAIN() function is very simple. It takes the input, .sort()s it using a
function numberToEnglish() and .join()s the results with commas and spaces
and outputs them with .say().
@ints.sort({ numberToEnglish($_) }).join(q{, }).say;
The numberToEnglish() function is where all the work happens. It is a recursive
function that takes an integer as its' only argument and converts it to a string.
sub numberToEnglish(Int $n) {
We begin by creating tables mapping a digit in a particular decimal place to its'
corresponding English word. These are state hashes because they will never need to
change.
state %ones = (
0 => 'zero',
1 => 'one',
2 => 'two',
3 => 'three',
4 => 'four',
5 => 'five',
6 => 'six',
7 => 'seven',
8 => 'eight',
9 => 'nine'
);
state %teens = (
10 => 'ten',
11 => 'eleven',
12 => 'twelve',
13 => 'thirteen',
14 => 'fourteen',
15 => 'fifteen',
16 => 'sixteen',
17 => 'seventeen',
18 => 'eighteen',
19 => 'nineteen'
);
state %tens = (
20 => 'twenty',
30 => 'thirty',
40 => 'forty',
50 => 'fifty',
60 => 'sixty',
70 => 'seventy',
80 => 'eighty',
90 => 'ninety'
);
if $n is 0, we don't need to do much calculation. We just return %ones{0}
which is zero.
if $n == 0 {
return %ones{0};
}
If $n was not 0, we take its' absolute value as negative integers are dealt
with later.
my $abs = $n.abs;
Most numbers are going to translate into multiple words. As the translation
is built, we store the parts in a list called, aptly, @parts.
my @parts;
If $n is in billions, millions or thousands, we call numberToWords() recursively
and add the result plus the appropriate scale word to @parts.
if $abs >= 1_000_000_000 {
@parts.push(numberToEnglish($abs div 1_000_000_000) ~ ' billion');
$abs %= 1_000_000_000;
}
if $abs >= 1_000_000 {
@parts.push(numberToEnglish($abs div 1_000_000) ~ ' million');
$abs %= 1_000_000;
}
if $abs >= 1_000 {
@parts.push(numberToEnglish($abs div 1_000) ~ ' thousand');
$abs %= 1000;
}
If $n is less than a thousand, we use the appropriate table (%ones can also be
used for hundreds) to build up the translation.
if $abs >= 100 {
@parts.push(%ones{$abs div 100} ~ ' hundred');
$abs %= 100;
}
if $abs >= 20 {
my $tens = $abs div 10 * 10;
my $ones = $abs mod 10;
if $ones == 0 {
@parts.push(%tens{$tens});
} else {
@parts.push("%tens{$tens}-%ones{$ones}");
}
} elsif $abs >= 10 {
@parts.push(%teens{$abs});
} elsif $abs > 0 {
@parts.push(%ones{$abs});
}
All the parts are .join()ed into one string with spaces.
my $result = @parts.join(" ");
As a last step, if $n was a negative number, the word 'negative' is prepended to the
result.
return $n < 0 ?? "negative $result" !! $result;
}
This is the Perl version translated directly from Raku.
say join q{, }, sort { numberToEnglish($a) cmp numberToEnglish($b) } @ints;
sub numberToEnglish($n) {
state %ones = (
0 => 'zero',
1 => 'one',
2 => 'two',
3 => 'three',
4 => 'four',
5 => 'five',
6 => 'six',
7 => 'seven',
8 => 'eight',
9 => 'nine'
);
state %teens = (
10 => 'ten',
11 => 'eleven',
12 => 'twelve',
13 => 'thirteen',
14 => 'fourteen',
15 => 'fifteen',
16 => 'sixteen',
17 => 'seventeen',
18 => 'eighteen',
19 => 'nineteen'
);
state %tens = (
20 => 'twenty',
30 => 'thirty',
40 => 'forty',
50 => 'fifty',
60 => 'sixty',
70 => 'seventy',
80 => 'eighty',
90 => 'ninety'
);
if ($n == '0') {
return $ones{0};
}
my $abs = abs($n);
my @parts;
if ($abs >= 1_000_000_000) {
push @parts, numberToEnglish(int($abs / 1_000_000_000)) . ' billion';
$abs %= 1_000_000_000;
}
if ($abs >= 1_000_000) {
push @parts, numberToEnglish(int($abs / 1_000_000)) . ' million';
$abs %= 1_000_000;
}
if ($abs >= 1_000) {
push @parts, numberToEnglish(int($abs / 1_000)) . ' thousand';
$abs %= 1000;
}
if ($abs >= 100) {
push @parts, $ones{int($abs / 100)} . ' hundred';
$abs %= 100;
}
if ($abs >= 20) {
my $tensVal = int($abs / 10) * 10;
my $onesVal = $abs % 10;
if ($onesVal == 0) {
push @parts, %tens{$tensVal};
} else {
push @parts, "$tens{$tensVal}-$ones{$onesVal}";
}
} elsif ($abs >= 10) {
push @parts, $teens{$abs};
} elsif ($abs > 0) {
push @parts, $ones{$abs};
}
my $result = join q{ }, @parts;
return ($n < 0) ? "negative $result" : $result;
}