Another explosive weekly challenge. And by explosive I mean exponential complexity. Let's see what we've got. First I'll adjust the background music for equilibrium ... Comfortably Numb

Relax, I'll Need Some Information First

You are given an array of numbers. Write a script to find all subsets where the sum of elements equals the sum of their indices.

# Example 1 Input: @nums = (2, 1, 4, 3)
#.          Output: (2, 1), (1, 4), (4, 3), (2, 3)
#   Subset 1: (2, 1) Values: 2 + 1 = 3 Positions: 1 + 2 = 3
#   Subset 2: (1, 4) Values: 1 + 4 = 5 Positions: 2 + 3 = 5
#   Subset 3: (4, 3) Values: 4 + 3 = 7 Positions: 3 + 4 = 7
#   Subset 4: (2, 3) Values: 2 + 3 = 5 Positions: 1 + 4 = 5
#
# Example 2 Input: @nums = (3, 0, 3, 0)
#           Output: (3, 0), (3, 0, 3)
#   Subset 1: (3, 0) Values: 3 + 0 = 3 Positions: 1 + 2 = 3
#   Subset 2: (3, 0, 3) Values: 3 + 0 + 3 = 6 Positions: 1 + 2 + 3 = 6
#
# Example 3 Input: @nums = (5, 1, 1, 1)
#           Output: (5, 1, 1)
#   Subset 1: (5, 1, 1) Values: 5 + 1 + 1 = 7 Positions: 1 + 2 + 4 = 7
#
# Example 4 Input: @nums = (3, -1, 4, 2)
#           Output: (3, 2), (3, -1, 4)
#   Subset 1: (3, 2) Values: 3 + 2 = 5 Positions: 1 + 4 = 5
#   Subset 2: (3, -1, 4) Values: 3 + (-1) + 4 = 6 Positions: 1 + 2 + 3 = 6
#
# Example 5 Input: @nums = (10, 20, 30, 40)
#           Output: ()

Just the Basic Facts, Can You Show Me Where It Hurts?

Perusing the examples, I see that there are a couple of unstated requirements. From example 1, the improper subset (1,2,3,4) should work, but it's not in the given output, so apparently that should be excluded. And in example two, the subset (3) should work, but it's not in the output, so apparently subsets have to have at least two members.

I don't see any way of doing this other than generating all possible subsets and checking if they work. My approach is going to be to number the positions, and generate all possible subsets of the positions. Extracting members from the given list will be done with a hash slice. There's going to be a little annoyance that the task numbers positions starting from 1, while Perl array indexing is based from 0.

For a set of n members, there are 2ⁿ-1 possible subsets. I know that a way to generate subsets is to count from 1 to 2ⁿ-1 and check which bits are 1s in the binary representation. I know how to generate all possible subsets, but do I want to? Because I also know that there are CPAN modules that do this, and I have Algorithm::Combinatorics hanging around from previous problems, with its convenient subsets function, so let's use that.

I Do Believe It's Working, Good

sub sseq(@nums)
{
    use Algorithm::Combinatorics qw/subsets/;
    use List::Util qw/sum0/;
    my @result;

    my $s = subsets( [0 .. $#nums] );
    while ( my $position = $s->next() )
    {
        my $size = scalar(@$position);
        # Only proper subsets of size 2 or more
        next if $size == scalar(@nums) || $size < 2;

        # Subsets are indexed at zero, but positions at 1, so compensate in sum
        my $sumPosition = $size + sum0  @$position;

        my $sumNumbers = sum0 @nums[ @$position ];

        if ( $sumNumbers == $sumPosition )
        {
            push @result, [@nums[@$position]]
        }
    }
    return \@result;
}

Your Lips Move, But I Can't Hear What You're Saying

Explanatory notes:

• use Algorithm::Combinatorics qw/subsets/ -- This function creates an iterator to generate consecutive subsets from a given list of members. We're going to pass it a list of positions, from 0 to the last index of @nums.

• use List::Util qw/sum0/ -- sum0 handles empty lists by returning zero instead of an error, as sum does. That shouldn't come up in this particular function, but I generally use sum0 as my default, because I invariably get a warning from sum about an empty array and end up changing it anyway.

• my $size = scalar(@$position) -- the size of the position array comes up repeatedly, so let's get a handle on it.

• my @sumPosition = $size + sum0(...) -- The sum we're looking for is based on using positions numbered from 1, but we have them numbered from 0. We need to add 1 to each of the positions, which is the same as adding the number of positions.

• my @sumNumbers = sum0 @nums[ @$position ] -- Here's why I wanted positions to be indexed from zero: so that they could be used in a hash slice to extract the corresponding numbers.

• push @result, [@nums[@$position]] -- the result of this function is going to be a reference to an array of arrays (it's array reference turtles all the way down). Once again, the hash slice, now encased in [] to create an array reference.

That'll Keep You Going Through the Show

This function answers the question, but it leaves two things undone.

First, the order of the lists is unspecified. There's no apparent reason for the order in the examples, and I quickly found out that the subsets iterator doesn't return subsets in the same order as the examples.

To create unit tests, I want to check that arrays contain the same members, but order doesn't matter. In the Test2 suite, this can be accomplished by putting the expected elements into a bag data structure.

sub runTest
{
    use Test2::V0;
    use Test2::Tools::Compare qw/bag item/;
    my $check;

    $check = bag { item [1,4]; item [2,1]; item [2,3]; item [4,3]; end(); };
    is( sseq(2,1,4,3), $check, "Example 1");
[...]

Our bags are checked, so ...

Come On, It's Time To Go

Second, to display the output, we have to unwrap the array references and render them as formatted strings.

say join ", ", map { "(" . join(", ", $_->@*) . ")" } sseq(@ARGV)->@*;

What's going on here?

• sseq(@ARGV)->@* -- Call our function, using the command line arguments, and dereference it (which yields an array of array references).
• map { ... } -- Transform each of the array references
• "(" . join(", ", $_->@*) . ")" -- $_ is a reference to an array, so $_->@* is the list of elements in the array. Make it a comma-separated string, encased in parentheses.
• say join ", ", ... -- output each of those parenthesized strings, separated by commas

I Have Become Comfortably Numb

Equilibrium achieved.

Originally published at Perl Weekly 770

Hi there,

I like to believe that I belong to the old school of testing i.e. Test::More. That being said, every now and then I come across a magical test workflow. One of them is App::Yath. The biggest and pleasant surprise is that both were presented by none other than Chad Granum. Although I love the idea, I find it hard to adapt to it. I have to force myself otherwise it won't happen. I wrote a short blog post as a reminder to myself while working on this editorial. I can refer to it next time I am changing existing code or adding new code.

Speaking of testing, Herbert Breunung shared a blog post explaining how Test::Builder helped him create his own test suite. This reminded me how I did exactly that in 2010 to create Test::Map::Tube for my routing framework, Map::Tube. It makes me feel quite old now!

Enjoy rest of the newsletter.

--
Your editor: Mohammad Sajid Anwar.

Announcements

The London Perl and Raku Workshop 2026

Just a heads up: The next LPW is planned to be in November 2026.

PPC Summer 2026 - Call for Participation!

Brett Estrade, who is a member of the Perl Community Conference (PPC) organising committee, has released a call for participants for the Summer 2026 PPC. He notes the group's success in the areas of scientific research and community building through the use of independent Perl conferences and asks for speakers to submit proposals to present their work via the Papercall system to help keep the momentum going.

Articles

Who tests the tester? Me !!!

In the article, Lichtkind shows how to apply the Test::Builder::Tester module to check your own test functions for correctness. He shares real-life example of using the is_tuple() function that he has developed to aid in creating a test for the GTC project.

This week in PSC (222) | 2026-04-25

Ihe Perl Steering Council got together at the 2026 Perl Toolchain Summit (Vienna). During this meeting, the group discussed the current status of Perl 5.44. Most blockers have been resolved and EOL workflow has been put in place. Finalisation of details for the next stable release is currently taking place.

Importance of Repositories in Public

In this blog post, Mikko argues that keeping project repositories publicly accessible is an important practice even when no new contributions are anticipated. Having a project public on GitHub preserves historical context, serves as an example of quality work for others, and provides a source of useful data for the open-source community.

AI as a Chance - Opinion

In this article PetaMem discussed how through AI we will have access to new ways to enhance our creative processes (as opposed to replacing them), through developing a partnership with AI; allowing developers and creators alike use the technology of AI to automate repetitive processes and create opportunities for problems to be solved and new ideas developed through creative innovation.

Discussion

AI Contributions to CPAN: The Copyright Question

In his article, Todd explores some of the legal issues surrounding code that is generated by AI and available through CPAN, and whether or not these AI-generated contributions are eligible for copyright protection and/or a legal license. He also cautions maintainers about the use of black box LLMs, which do not make public their training data, and encourages the Perl community to develop guidelines for the proper protection of the Perl software ecosystem from future disputes arising from improper use of code generated by LLMs.

Web

Use Your Powers Only for Good, Clark

Dave dissects a really good looking SPAM email made by an AI LLM to show us all how the world will look in future with AI created outreach. Even though the spam had accurately scraped Dave's background and book titles, Dave believes that this creates the illusion of understanding but does not demonstrate the LLM has any real knowledge of either Dave's values or business model. Dave further states that this type of outreach is now cheaper and easier than ever though the deployment of AI to create large amounts of unsolicited SPAM.

The Weekly Challenge

The Weekly Challenge by Mohammad Sajid Anwar will help you step out of your comfort-zone. You can even win prize money of $50 by participating in the weekly challenge. We pick one champion at the end of the month from among all of the contributors during the month, thanks to the sponsor Marc Perry.

The Weekly Challenge - 371

Welcome to a new week with a couple of fun tasks "Missing Letter" and "Subset Equilibrium". If you are new to the weekly challenge then why not join us and have fun every week. For more information, please read the FAQ.

RECAP - The Weekly Challenge - 370

Enjoy a quick recap of last week's contributions by Team PWC dealing with the "Popular Word" and "Scramble String" tasks in Perl and Raku. You will find plenty of solutions to keep you busy.

Perl Weekly Challenge 370: Popular Word

Abigail offers a superb example of processing text for the "Popular Word" task using the ability of Perl's regex engine to process words without considering case and complex punctuation marks. This solution is unique because it demonstrates a high-performance solution for filtering out banned words while maintaining concise and easily readable code.

Perl Weekly Challenge 370: Scramble String

Abigail used a clever recursive method to take on the challenge of the "Scramble String" problem. The use of clear base cases and logic to explore possible points to split and swap all contribute to the final solution being an excellent example of how to solve complex problems with string transformations, using a valid solution and providing a framework that can be used to solve other complex problems involving string transformations.

Popular Scramble

Arne's experience in comparing Raku's expressive power vs. Perl with respect to the solutions of these two challenges are at the heart of this review. He also demonstrates how to use Raku's built-in Bag and Any types to simplify complex logic with clean, idiomatic code. This article is a great reference for developers who want to learn how to use modern functional programming patterns effectively.

PWC 370 Scramble On, Scramblin' Man

Bob has created a detailed breakdown of the Scramble String problem, looking at the need to use memoisation to avoid redundantly calculating recursive algorithms. Bob has developed a very clearly constructed solution to the Scramble String problem using test-first development which is a perfect demonstration of how to keep performance and readability on complex branching logic.

Perl Weekly Challenge: Week 370

In this article, there is a thorough comparison made between two languages: Perl and Raku. The many modern capabilities of Raku, such as having a Bag data structure and being natively supportive of methods for manipulating strings, resulted in solving the stated problem while producing significantly less code than what is generated by using Perl to do the same thing.

Scrambled Bans

Jörg has concentrated his efforts solely on providing a high quality Perl solution to this challenge. The way he solves "Scramble String" is especially impressive because he uses a recursive solution that processes challenging partitioning and swapping of strings, using clean and idiomatic Perl programming.

Perl Weekly Challenge 370

W. Luis Mochán offers a mathematically rigorous and elegant take on Challenge 370 using Perl. For Task 1, he utilises a compact approach by normalising the input with lc and regex, then applying a frequency count. His review is particularly positive about the clarity and efficiency of using a single hash to filter out banned words while identifying the maximum frequency in one pass. For Task 2, he implements a recursive solution and highlights the technical necessity of caching results to avoid the exponential growth of possibilities in longer strings.

Scrambling Back and Forth

Matthias's submission for Task 1, he has used a concise and efficient one-liner with List::UtilsBy::max_by to count how many times words appear and in doing so stores a reference to the 'most popular' result while processing all results in a single pass. With respect to Task 2, Matthias did not limit himself to performing a simple recursive search as in previous weeks; however, he developed a Reverse Scramble algorithm, which is performing this task as a sequence of sorting in which strings become indexes of streaks representing their sorted order to allow for efficient verification of scrambling operations performed.

The scramble can not stop you / from becoming popu-ler… lar

Packy's polyglot Challenge 370 features solid code samples in Perl, Raku, Python, and Elixir that showcase how to solve the problem multiple ways using different programming languages. He shows how using Elixir's pipe operator or Raku's Bag can help efficiently transform and filter the paragraph from "Most Popular Word". He also demonstrates a consistent, recursive approach to solving the problem using the same recursive logic, with code examples in each of the four languages, while adapting to the specific syntax and idioms of each language, in his example "Scramble String".

Words and more words

Peter implements a clean regular expression approach to normalising the text and eliminating any banned words in Popular Word, while also provides a completely recursive solution in Scramble String that clearly demonstrates splitting and swapping parts of the string in order to illustrate the property of being scrambled.

The Weekly Challenge - 370: Popular Word

Reinier solution includes a simple regular expression to remove punctuation characters and a hash to count the number of occurrences of each valid word. This makes it easy to identify the most frequently used word that is not on a banned list, and provides an easily readable model from which to analyze text.

The Weekly Challenge - 370: Scramble String

Reinier's demonstrates pruning as an optimisation technique. If the characters sorted for both strings do not match (meaning they are not anagrams), the function returns false without going through all remaining recursive levels.

The Weekly Challenge #370

Robbie's high-performance Perl solutions employ algorithmic efficiency and strong input validation. In Task 1, he uses a fast normalisation method along with a hash-based frequency counting scheme to isolate the most popular word. In Task 2, Robbie's "Scramble String" implementation is notable for being a recursive Divide-and-Conquer strategy, providing an additional speedup by implementing a pre-check anagram filter to eliminate expensive recursive calls to incompatible strings.

Popular Scramble

Roger shown how to use a specialised programming tool like Counter in Rust to find popular words with only a few lines of code. In addition, the example in PostScript is an interesting concept as it shows how to create a counted hash from scratch using the examples provided in the Rust program as a reference.

Popular Scrambling

Simon demonstrates Task 1 by methodically normalising strings and counting strings using hashes in order find the word with the highest occurrence. His solution for Task 2 highlights the use of recursion when solving the problem, and optimises by checking if two strings are anagrams with a "fail-fast" method; this way, all non-anagrams can be filtered out before going through the more complex process of recursion.

Perl Tutorial

A section for newbies and for people who need some refreshing of their Perl knowledge. If you have questions or suggestions about the articles, let me know and I'll try to make the necessary changes. The included articles are from the Perl Maven Tutorial and are part of the Perl Maven eBook.

Testing in Perl

The 'slides' with all the examples that are used in the online course.

Rakudo

2026.16 Selkie TUI Framework

Training

Testing in Perl

While we are still recording the live sessions of the Testing in Perl you can also watch the previous episodes on the Code Maven Academy web site. Usually it is for paying subscribers only, but for the next couple of day you can still access it free of charge. You only need to register on the web site.

Weekly collections

NICEPERL's lists

Great CPAN modules released last week.

Events

Perl Maven online: Testing in Perl - part 5

April 30, 2026

Boston Perl Mongers virtual monthly

May 12, 2026

The Perl and Raku Conference 2026

June 26-29, 2026, Greenville, SC, USA

You joined the Perl Weekly to get weekly e-mails about the Perl programming language and related topics.

Want to see more? See the archives of all the issues.

Not yet subscribed to the newsletter? Join us free of charge!

(C) Copyright Gabor Szabo
The articles are copyright the respective authors.

If your girlfriend has been kidnapped by Gollum and the Evil One, and there's nothing you can do, perhaps console yourself with a small programming problem while you listen to Ramble On or Ramblin' Man'.

PWC 370 Task 2: Scramble String

The Task

You are given two strings A and B of the same length. Write a script to return true if string B is a scramble of string A otherwise return false. String B is a scramble of string A if A can be transformed into B by a single (recursive) scramble operation. A scramble operation is:

• If the string consists of only one character, return the string.
• Divide the string X into two non-empty parts.
• Optionally, exchange the order of those parts.
• Optionally, scramble each of those parts.
• Concatenate the scrambled parts to return a single string.

Examples

1. Input: $str1 = "abc", $str2 = "acb" Output: true
   • split: ["a", "bc"]
   • split: ["a", ["b", "c"]]
   • swap: ["a", ["c", "b"]]
   • concatenate: "acb"
2. Input: $str1 = "abcd", $str2 = "cdba" Output: true
   • split: ["ab", "cd"]
   • swap: ["cd", "ab"]
   • split: ["cd", ["a", "b"]]
   • swap: ["cd", ["b", "a"]]
   • concatenate: "cdba"
3. Input: $str1 = "hello", $str2 = "hiiii" Output: false
4. Input: $str1 = "ateer", $str2 = "eater" Output: true
5. Input: $str1 = "abcd", $str2 = "bdac" Output: false

The Ramblin' Scramblin' Thinkin' Part

This could go two ways: (1) generate every possible scramble of str1 and then look for str2; or (2) do a breadth-first or depth-first search for str2.

The possible number of scrambles could explode. For a length of n, there will be n-1 splits, and then the n-1 string will have n-2 splits, and so on, so we're looking at factorial complexity. Let's not generate every possible scramble unless we have to.

For a search, we'd be trying to match the front or back halves of the two strings, and then recursing on the parts that didn't match. There are finite possibilities for partial matches.

• A simple swap gets us from str1 to str2:

  str1:    ---  ++++++++++
  str2:    ++++++++++  --- 

• The head or tail of str1 matches the corresponding head or tail of str2, requiring us to recurse on the shorter string that didn't yet match.

   str1:   ===  [??????????]    ||    [???]   ==========
            |     scramble           scramble      |
            |         |                 |          |
   str2:   ===  [.*#.*#.*#.]    ||    [.*#]   ==========

• The head or tail of str1 matches the back or front of str2. Similar to the case above, except that a swap is required before we recurse.

   str1:  ===  [??????????]   ||   [???] =========
                     /               \
             scramble                 scramble
               /                              \
   str2:  [.*#.*#.*#.]  ===   ||   ========= [.*#]

A Bold Strategy, Cotton. Let's see if that works out for him.

After an embarrassing amount of trial and error (you might say I was scrambling), my solution converged on this longer-than-usual recursive function.

sub isScramble($str1, $str2, $depth = "")
{
    state %remember;
    %remember = () if $depth eq "";

    my $key = ":$str1:$str2:";
    if ( exists $remember{$key} )
    {
        $logger->debug("${depth}CACHED $key = ", ($remember{$key} ? "true":"false"));
        return $remember{$key}
    }

    my $len = length($str1);
    return ( $remember{$key} = false) if $len != length($str2);
    return ( $remember{$key} =  true) if $str1 eq $str2;

    for ( 1 .. $len-1 )
    {
        # $_ is the length of the left substring (head), $len-$_ is length of right (tail)
        my (  $head,   $tail) = ( substr($str1, 0, $_), substr($str1, $_) );
        my ($s2head, $s2tail) = ( substr($str2, 0, $_), substr($str2, $_) );

        my $s2front = substr($str2, 0, $len-$_);   # length of $tail, on left side
        my $s2back  = substr($str2, -$_);          # length of $head, on right side

        $logger->debug("${depth}Compare [$head/$tail] <> s2head/$s2tail] ($s2front/$s2back)");

        if ( "$tail$head" eq $str2 )
        {
            $logger->debug("${depth}FOUND $str2");
            return $remember{$key} = true;
        }
        elsif ( $head eq $s2head )
        {
            $logger->debug("${depth}HH, compare $tail <> $s2tail");
            return true if $remember{$key} = isScramble($tail, $s2tail, "  $depth");
        }
        elsif ( $head eq $s2back )
        {
            $logger->debug("${depth}HB, compare $tail <> s2front");
            return true if $remember{$key} = isScramble($tail, $s2front, "  $depth");
        }
        elsif ( $tail eq $s2tail )
        {
            $logger->debug("${depth}TT, compare $head <> s2head");
            return true if $remember{$key} = isScramble($head, $s2head, "  $depth");
        }
        elsif ( $tail eq $s2front )
        {
            $logger->debug("${depth}TF, compare $head <> s2back");
            return true if $remember{$key} = isScramble($head, $s2back, "  $depth");
        }
        else
        {
            $logger->debug("${depth}No pairs, recurse with $head<>$s2head and $tail<>$s2tail");
            return $remember{$key} = true if ( 
                   ( isScramble($head, $s2head, "  $depth")
                  && isScramble($tail, $s2tail, "  $depth") )
                || ( isScramble($head, $s2back, "  $depth")
                  && isScramble($tail, $s2front, "  $depth") ) );
        }
    }

    $logger->debug("${depth}NOT FOUND $key = false (caching)");
    return $remember{$key} = false;
}

Notes:

• The function starts out with setting up a cache for partial results. During development, I added this near the end of the process, but it shows up at the top of the function, so let's discuss it.

  • Recursive search algorithms usually benefit from caching known results. Our worst case is that str1 can't be scrambled into str2, in which case we'll end up doing the whole exponential tree of possibilities. I expect caching partial results would pay off.
  • The %remember hash is my cache, and it's a state variable so that it persists across recursive calls. But that means it also persists across invocations for different test cases, so it could yield wrong answers unless I initialize it at the top level of the recursion.
  • The cache is filled by using in-line assignment every time a result is returned, which is kind of cutely readable, I think.
  • Should I have used Memoize? Maybe. But that caches values based on the arguments passed to the function, and one of my arguments is the depth to which I've recursed. That means cache misses depending on how I got down the search tree, so I opted for do-it-yourself memo-ization.

• The function begins by dispensing with the easy cases: having a result in the cache, matching strings, and strings of the wrong length.

• Then, for each division of str1, let's have at hand the substrings that we might be dealing with from both str1 and str2. There's a little tour-de-force of substr uses here, splitting the strings at a midpoint, and using negative offsets.

• Most of the body of the function is testing which pairs match up, if any, and doing the appropriate recursion of what remains.

• The last case, where neither the head nor the tail of str1 has a matching complement in str2, requires us to recurse on both pieces, and in either order.

• I used logging liberally, because the function is only obvious in hindsight and took me longer than I'd like to admit. The $depth argument is mostly a convenience for indenting the log statements appropriately -- notice that it gets longer by two spaces at each recursion. My setup for logging uses Log::Log4perl in easy mode. It's part of my boilerplate for PWC solutions and looks like this:
  
  

use Getopt::Long;
my $Verbose = false;
my $DoTest  = false;

GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
my $logger;
{
    use Log::Log4perl qw(:easy);
    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
    $logger = Log::Log4perl->get_logger();
}

Week 370

My Solutions
Task 1 : Popular Word (By M. Anwar)

You are given a string paragraph and an array of the banned words. Write a script to return the most popular word that is not banned. It is guaranteed there is at least one word that is not banned and the answer is unique. The words in paragraph are case-insensitive and the answer should be in lowercase. The words can not contain punctuation symbols.

For frequency of words I immediately plan to use a hash. My only hangup on this one was when the input paragraph was not space separated but used punctuation marks instead. This could be more robust, but that's an abnormal input. I turn everything lowercase, check for spaces, strip out the punctuation marks, and put the word count in the hash %h. Then we ignore banned words.

sub strip($w) {
    my $out;
    for my $letter (split '', $w) {
    $out .= $letter if ($letter =~ /\w/);
    }
    return $out;
}

sub proc($paragraph, @banned) {
    say "Input:  \$paragraph = $paragraph\n\t\@banned = @banned";
    my @words;
    if ($paragraph =~ /\s/) {
    @words = split ' ', lc $paragraph;
    } else {
    my $word;
    for my $letter (split '', lc $paragraph) {
        if ($letter =~ /[a-zA-Z]/) {
        $word .= $letter;
        } else {
        push @words, $word;
        $word = "";
        }
    }
    }
    my %h;
    foreach my $word (@words) {
    $word = strip($word);
    $h{$word}++;
    }
    my $max = 0;
    my $max_word;
    for my $w (keys %h) {
    my $ban = 0;
    for my $banned_word (@banned) {
        if ($w eq $banned_word) {
        $ban = 1;
        last;
        }
    }
    next if ($ban);
    if ($max < $h{$w}) {
        $max_word = $w;
        $max = $h{$w};
    }
    }
    say "Output: $max_word";
}

Task 2: Scramble String (By R. B-W)

You are given two strings $str1 and $str2 of the same length. Write a script to return true if $str2 is a scramble of $str1 otherwise return false. String B is a scramble of string A if A can be transformed into B by a single (recursive) scramble operation.

Mr. Roger Bell-West then goes on to explain what a scramble is.

• If the string consists of only one character, return the string.
• Divide the string X into two non-empty parts.
• Optionally, exchange the order of those parts.
• Optionally, scramble each of those parts.
• Concatenate the scrambled parts to return a single string.

When the task was first described, he had suggested choosing a random location for the split, and randomly deciding to perform the scrambles or swaps. I decided to embrace that approach.

I loop the scramble 10,000 times to increase the odds of success.

sub scramble($s) {
    my $len = length($s);
    if ($len == 1) {
    return $s;
    } else {
    my $pt = 1 + ($len - 1) * rand();
    my $a = substr $s, 0, $pt;
    my $b = substr $s, $pt;
    my $a_new = (int 2*rand() == 0) ? $a : scramble($a);
    my $b_new = (int 2*rand() == 0) ? $b : scramble($b);
    my $out = (int 2*rand() == 0) ? $a_new.$b_new : $b_new.$a_new;
    }
}