Episode 390 of The Weekly Challenge brings us a couple of tasks that turned out to be less code than I first thought. Let's put on some mood music and have a look. How about Sarah McLachlan's 1997 album, Surfacing, where the first song is titled "Building a Mystery" -- appropriate for a task about decoding. Task 1: Decode String Task Description 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" Task Analysis At first glance, this looked like it was going to involve parsing balanced sets of nested brackets, which would mean some kind of stack structure, or maybe a simple recursive descent parser. It might be an opportunity to apply Perl modules that help with extracting balanced bracket groups; Text::Balanced for example. However, backing off the keyboard for a moment, I noticed that there is a fundamental unit in the encoding. To repeat a constant string, the form is N[s]. This means to repeat the string s for N times. Perl has a replication operator, $s x $N, which also means to repeat a string $s for $N times. A textual transformation can turn a fundamental group into a bit of equivalent Perl code. Execute the bit of code and that string is decoded. # "3[a]" ==> eval { 'a' x 3 } ==> 'aaa' s/ (\d+) \[ ( [^[\]]+) \] /$2 x $1/xeg Some regular expression deep cuts here: /x -- this flag allows me to add some white space into the regular expression for readability. You are free to judge just how much readability was accomplished. (\d+) -- captures a group of digits as $1. \[ and \[ -- the brackets would be meta-characters, so they need to be escaped to match literally. [^[\]]+ -- matches any character that is not a bracket. This will be captured into $2. Note that I can't just move forward over everything that's not a ']' -- it would fail for strings like Example 1 ("2[3[a]]"), because it would match "3[a" after the "2[". /e - this flag executes the code in the substitution. When this substitution is applied, it eliminates a level of brackets. If we keep doing that until there are no brackets left, then we will have decoded the entire string. The task reduces to a one-liner. sub task($str) { while ( $str =~ s/ (\d+) \[ ( [^[\]]+ ) \] /$2 x $1/gxe ) { } return $str; } Task 2: Order Characters Task Description You are given a string $s (containing only alphabetic characters) and an integer $k > 0. Write a script to choose one of the first $k letters of the 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 first letter "g") Move 4: "seegk" (move first letter "k") Move 5: "eegks" (move first letter "s") 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" Example 6: Input: $str = "oloolooo", $k = 1 Output: "looloooo" Example 7: Input: $str = "oloooolo", $k = 1 Output: "looloooo" Task Analysis At first glance, the randomness of choosing one of $k positions seems to make this a difficult problem. However, what we really have here is a search problem over all possible moves. Which, OK, still potentially a hard problem. From the start word, we have $k new words that could be generated, and from each of those, $k more. Clearly this could blow up if $k is more than a small integer, but I don't see any way to take shortcuts, so exhaustive search it is. Searches are often presented or taught as recursive algorithms, but recursion is really just a way of hiding a stack. Searching requires two data structures: a stack or queue to hold the possibilities we haven't checked yet, and a lookup table to record things we have checked, so we don't get stuck in a loop. Side Quest I'll want a convenient way to transform a word. Given a value of $k, it should return the string with the k'th letter moved to the end of the string. I'm going to do it by combining the substring before k, the substring after k, and then k. sub move($s, $k) { substr($s, 0, $k-1) . substr($s, $k) . substr($s, $k-1, 1); } That feels like a lot of string operations. If we wanted to be too clever by half (and who doesn't), we could go into the fine print of the substr function and read about the optional fourth argument, which replaces a piece of the string and returns what was there before. Armed with that dangerous piece of knowledge, we could write magic that erases letter k and makes it reappear at the end. sub move($s, $k) { $s .= substr($s, $k-1, 1, ''); } The search is on For the search itself, I'll prime the pump by putting the first set of moves onto the stack, then processing the stack until it's empty. As we take a word off the stack, we'll ignore it if it's a word we've already processed. Otherwise, check if it's the best yet, and then generate a new set of $k moves for the stack. sub task($str, $k) { die "k out of range" if $k < 1 || $k > length($str); my $best = 'z' x length($str); my %seen; my @stack; push @stack, map { move($str, $_) } 1 .. $k; while ( my $word = pop @stack ) { next if $seen{$word}; $seen{$word} = true; $best = $word if $word lt $best; push @stack, map { move($word, $_) } 1 .. $k; } return $best; } Notes: We can push multiple items onto the end of an array in one statement. Instead of a for loop, I'm using map to make a list of the $k moves. Lexicographic comparison uses the lt operator instead of <. I'm using pop to process the stack, which makes it a depth-first search. If I used shift, it would be a breadth-first search (and the stack would act like a queue). Since we have to look at every possible word, it doesn't much matter which we use. But wait, there's more This solution doesn't record the set of moves that got to the result. If I needed that, the stack would contain records of two things: the word to be processed, and a reference to a list of words. The initial stack for Example 3 would look like: ( ["baedc", ["cbaed"] ], # move("cbaed", 1) ["caedb", ["cbaed"] ], # move("cbaed", 2) ["cbeda", ["cbaed"] ], ) # move("cbaed", 3) Processing the stack would involve unpacking this structure, and growing the list of words that got us here. while ( pop @stack ) { my $word = $_->[0]; my $howWeGotHere = $_->[1]; next if $seen{$word}; $seen{$word} = true; push @$howWeGotHere, $word; To get this information out of the function, we would need to remember not only the best word, but also the path that reached it. We would then return either a pair of values in a list, or return multiple values. Returning multiple values stumbles into the swamp of array versus scalar context, so I prefer to return a single reference to a pair of things. my $best = 'z' x length($str); my $bestPath = [ $str ]; [ . . . ] if ( $word lt $best ) { $best = $word; $bestPath = [ $howWeGotHere->@* ]; } [ . . . ] return [$best, $bestPath];