Perl Weekly Challenge: Week 390
Challenge 1:
Decode String
You are given an encoded string.
Write a script to return the decoded string of the given encoded string.
The encoding rule is: K[encoded_string], where the encoded_string inside the square brackets is repeated exactly K > 0 times.
Example 1
Input: $str = "2[3[a]]"
Output: "aaaaaa"
3[a] => aaa
2[3[a]] => aaa aaa
Example 2
Input: $str = "10[a]"
Output: "aaaaaaaaaa"
Example 3
Input: $str = "a2[b]c3[d]e"
Output: "abbcddde"
Example 4
Input: $str = "2[a2[b]c]"
Output: "abbcabbc"
Example 5
Input: $str = "1[a]2[b3[c]]"
Output: "abcccbccc
It is useful to think of this problem as similiar to parsing Reverse Polish Notation arithmetic though not as complicated; instead of operators we have K and instead of operands we have the encoded_string inside the square brackets. So we can use a similar dual stack-based approach.
The @counts stack will store values of K—the number of repetions—as we find them. This has to be a stack because we can nest multiple encoding strings
inside each other.
my @counts;
The @parts stores the string that is currently being built at each nesting level. It
initially contains one empty string.
my @parts = q{};
Because K can consist of more than one digit, we need a place to hold them
before use. It defaults to an empty string.
my $count = q{};
We split up $str into individual characters and them for each character...
for $str.comb -> $c {
given $c {
...if the character is a digit, we append it to $count.
when /\d/ {
$count ~= $c;
}
...if the character is a [...
when q{[} {
$count is appended to @counts.
@counts.push($count);
A new, empty string is appended to @parts.
@parts.push(q{});
$count is reset to an empty string.
$count = q{};
}
... if the character is a ]...
when q{]} {
The last string is taken off the end of @parts and assigned to $part.
my $part = @parts.pop;
The last number is taken off the end of @counts and assigned to $repeat.
my $repeat = @counts.pop;
$repeat and $part are used to create a repeated string using the x operator
which is appended to the last element of @parts.
@parts[*-1] ~= $part x $repeat;
}
...if the character is anything else, it is appended to the last element of @parts
default {
@parts[*-1] ~= $c;
}
}
}
By the time we have gone through all of $str, @parts should only have one element
left which is the complete decoded string so we print it out with say().
say @parts[0];
This is the Perl version.
my @counts;
my @parts = q{};
my $count = q{};
for my $char (split //, $str) {
The chief difference is that given...when is deperecated in Perl so we use if...elsif...elese instead.
if ($char =~ /\d/) {
$count .= $char;
} elsif ($char eq q{[}) {
push @counts, $count;
push @parts, q{};
$count = q{};
} elsif ($char eq q{]}) {
my $part = pop @parts;
my $repeat = pop @counts;
$parts[-1] .= $part x $repeat;
} else {
$parts[-1] .= $char;
}
}
say $parts[0];
Challenge 2:
Order Characters
You are given a string
$s(containing only alphabetic characters) and an integer$k > 0.Write a script to choose one of the first
$kletters of given string and append it at the end of the string. You keep doing this until you have lexicographically smallest string and return the string.
Example 1
Input: $str = "dbca", $k = 1
Output: "adbc"
Move 1: "bcad"
Move 2: "cadb"
Move 3: "adbc"
Example 2
Input: $str = "geeks", $k = 2
Output: "eegks"
First 2 letters: "g", "e"
Move 1: "gekse" (move second letter "e")
Move 2: "gksee" (move second letter "e")
Move 3: "kseeg"
Move 4: "seegk"
Move 5: "eegks"
Example 3
Input: $str = "cbaed", $k = 3
Output: "abcde"
First 3 letters: "c", "b", "a"
Move 1: "cbeda" (move "a")
Move 2: "cedab" (move "b")
Move 3: "edabc" (move "c")
Move 4: "eabcd" (move "d")
Move 5: "abcde" (move "e")
Example 4
Input: $str = "fedcba", $k = 4
Output: "abcdef"
First 4 letters: "f", "e", "d", "c"
Move 1: "fdcbae" (move "e")
Move 2: "dcbaef" (move "f")
Move 3: "dcbefa" (move "a")
Move 4: "dcefab" (move "b")
Move 5: "defabc" (move "c")
Move 6: "efabcd" (move "d")
Move 7: "fabcde" (move "e")
Move 8: "abcdef" (move "f")
Example 5
Input: $str = "perl", $k = 1
Output: "erlp"
Move 1: "erlp" (move "p")
Example 6
Input: $str = "oloolooo", $k = 1
Output: "looloooo"
Example 7
Input: $str = "oloooolo", $k = 1
Output: "looloooo"
Well, I found a solution for this challenge but I have a nagging feeling I'm
cheating somehow? You see, I noticed that you only have to do the choosing and
appending thing mentioned in the spec if $k = 1.
if $k == 1 {
In that case we define $smallest to hold the lexicographically smallest string
and initially set its' value to $str.
my $smallest = $str;
In order to get all possible rotations we go through the characters in $str
(except the last) one by one and created a rotateted string. Raku has a standard
library method .rotor() but that only works on lists. Rather than convert
$str into a list and back again, I did it like this as it is the same method
as I was going to use in Perl anyway.
for 0 ..^ $str.chars -> $i {
my $rotation = $str.substr($i) ~ $str.substr(0, $i);
If it is smaller than the current smallest string, it becomes the new value of
$smallest.
if $rotation lt $smallest {
$smallest = $rotation;
}
}
We print the final value of $smallest.
say $smallest;
If $k is greater than 1, we actually don't need to do any of that. We can
simply break up $str into characters with .comb(), .sort() thme in ascending
lexocographic order (the default) and .join() them back up into a string which
we can print with .say().
} else {
$str.comb.sort.join.say;
}
Like I said, I don't know if this is cheating, but it works for all the examples.
The Perl version the same as in Raku.
if ($k == 1) {
my $smallest = $str;
for my $i (0 .. length($str) - 1) {
my $rotation = substr($str, $i) . substr($str, 0, $i);
if ($rotation lt $smallest) {
$smallest = $rotation;
}
}
say $smallest;
} else {
say join q{}, (sort split //, $str);
}