Perl Weekly Challenge: Week 369
Challenge 1:
Valid Tag
You are given a given a string caption for a video.
Write a script to generate tag for the given string caption in three steps as mentioned below:
1. Format as camelCase
Starting with a lower-case letter and capitalising the first letter of each subsequent word.
Merge all words in the caption into a single string starting with a #.
2. Sanitise the String
Strip out all characters that are not English letters (a-z or A-Z).
3. Enforce Length
If the resulting string exceeds 100 characters, truncate it so it is
exactly 100 characters long.
Example 1
Input: $caption = "Cooking with 5 ingredients!"
Output: "#cookingWithIngredients"
Example 2
Input: $caption = "the-last-of-the-mohicans"
Output: "#thelastofthemohicans"
Example 3
Input: $caption = " extra spaces here"
Output: "#extraSpacesHere"
Example 4
Input: $caption = "iPhone 15 Pro Max Review"
Output: "#iphoneProMaxReview"
Example 5
Input: $caption = "Ultimate 24-Hour Challenge: Living in a Smart Home controlled entirely by Artificial Intelligence and Voice Commands in the year 2026!"
Output: "#ultimateHourChallengeLivingInASmartHomeControlledEntirelyByArtificialIntelligenceAndVoiceCommandsIn"
I didn't quite follow the algorithm given in the spec but did something similar.
First we split up the caption into a list of words with .words().
my @words = $caption.words;
Then we make sure the first word is lower case with .lc() and then the rest of the words
have their first character upper case (i.e. the word is "title case") with .map() and .tc(). These are joined together with .join() and the whole thing is appended to the first word.
my $result = @words[0].lc ~ @words[1..*].map({ $_.tc }).join;
In the next stage, .subst() is used to remove all non-alphabetic characters and the string
is added onto a # character.
$result = q{#} ~ $result.subst(/<-[A..Za..z]>/, q{}, :g);
Finally, we check the length of the result string. If it is less than or equal to 100, it
is truncated to 100 characters with .substr() otherwise left as-is. Either way, it is
output with say().
say $result.chars <= 100 ?? $result !! $result.substr(0, 100);
The Perl version works the same way as in Raku.
my @words = split /\s+/, $caption;
my $result = (lc $words[0]) . join q{}, map { ucfirst $_ } @words[1 .. $#words];
$result = q{#} . $result =~ s/[^A-Za-z]//gr;
say length $result <= 100 ? $result : substr($result, 0, 100);
Challenge 2:
Group Division
You are given a string, group size and filler character.
Write a script to divide the string into groups of given size. In the last group if the string doesn’t have enough characters remaining fill with the given filler character.
Example 1
Input: $str = "RakuPerl", $size = 4, $filler = "*"
Output: ("Raku", "Perl")
Example 2
Input: $str = "Python", $size = 5, $filler = "0"
Output: ("Pytho", "n0000")
Example 3
Input: $str = "12345", $size = 3, $filler = "x"
Output: ("123", "45x")
Example 4
Input: $str = "HelloWorld", $size = 3, $filler = "_"
Output: ("Hel", "loW", "orl", "d__")
Example 5
Input: $str = "AI", $size = 5, $filler = "!"
Output: "AI!!!"
When I read the description of this challenge, I immediately wondered if it could be done in one line. I did manage it but one might think my solution with four statements and over 100 character length strectches the limits of what should legitmately be considerd s one-liner. In any case for explanatory purposes, I will treat it as four lines.
First we create some variables so we don't have to constantly refer to @*ARGS. To save some
extra characters, i used the names $s, $z and $f instead of $str, $size and $filler.
my ($s,$z,$f) = @*ARGS;
$g also saves some space by caching the length of $str ($s) modulo $size ($z)
which is a calculation we will use more than once.
my $g = $s.chars % $z;
We add to $s the number of $f characters that would be needed to make its' length
an even multiple of $z but only if$g` is not 0.
$s ~= $f x ($g && $z -$ g);
Finally .comb() is used to split $s into groups of $z characters. 0 has to be
added to $z so it is treated as a number. The groups are .join()ed with commas and
spaces and printed with .say().
$s.comb($z+0).join(q{, }).say
The Perl solutiopn is of similiar length and works the same way.
($s,$z,$f) = @ARGV;
$g = (length $s) % $z;
$s .= $f x ($g && $z - $g);
say join q{, }, unpack("(A$z)*" , $s)