The Weekly Challenge 370

The Strategy: Remove punctuation, split into words, convert to lowercase, count frequencies excluding banned words, and return the word with the highest count.

sub popular_word {
    state $check = compile(Str, ArrayRef);
    my ($paragraph, $banned_ref) = $check->(@_);

    my %banned = map { lc $_ => 1 } @$banned_ref;

    # Remove punctuation and split
    $paragraph =~ s/[^\w\s]/ /g;
    my @words = map { lc } split /\s+/, $paragraph;

    my %count;
    for my $w (@words) {
        next if $banned{$w};
        $count{$w}++;
    }

    my ($popular, $max_freq) = ('', 0);
    for my $w (keys %count) {
        if ($count{$w} > $max_freq) {
            $popular = $w;
            $max_freq = $count{$w};
        }
    }
    return $popular;
}

def popular_word(paragraph: str, banned: Sequence[str]) -> str:
    """Return the most frequent non‑banned word in *paragraph*."""
    # Normalise: replace non‑word/space with space, lower case, split.
    words = re.sub(r"[^\w\s]", " ", paragraph).lower().split()
    banned_set = {b.lower() for b in banned}

    freq: dict[str, int] = {}
    for w in words:
        if w in banned_set:
            continue
        freq[w] = freq.get(w, 0) + 1

    # It is guaranteed that there is at least one non‑banned word and the answer is unique.
    return max(freq.items(), key=lambda kv: kv[1])[0]

The Strategy: Use recursion with memoization. First, check if the strings are equal. If not, check if they have the same character counts (prune). Then, for every possible split position, check the two possibilities: without swap and with swap.

sub scramble_string {
    state $check = compile(Str, Str);
    my ($s1, $s2) = $check->(@_);

    # Memoization
    state %memo;
    my $key = "$s1|$s2";
    return $memo{$key} if exists $memo{$key};

    if ($s1 eq $s2) {
        $memo{$key} = 1;
        return 1;
    }

    # Early exit: character counts must match
    my @cnt1 = (0) x 26;
    my @cnt2 = (0) x 26;
    for my $ch (split //, $s1) { $cnt1[ord($ch) - 97]++ }
    for my $ch (split //, $s2) { $cnt2[ord($ch) - 97]++ }
    for my $i (0 .. 25) {
        if ($cnt1[$i] != $cnt2[$i]) {
            $memo{$key} = 0;
            return 0;
        }
    }

    my $n = length $s1;
    for my $i (1 .. $n-1) {
        # No swap
        if (scramble_string(substr($s1,0,$i), substr($s2,0,$i)) &&
            scramble_string(substr($s1,$i), substr($s2,$i))) {
            $memo{$key} = 1;
            return 1;
        }
        # Swap
        if (scramble_string(substr($s1,0,$i), substr($s2,$n-$i)) &&
            scramble_string(substr($s1,$i), substr($s2,0,$n-$i))) {
            $memo{$key} = 1;
            return 1;
        }
    }

    $memo{$key} = 0;
    return 0;
}

from functools import lru_cache

@lru_cache(maxsize=None)
def _is_scramble(s1: str, s2: str) -> bool:
    """Return True if s2 is a scramble of s1 using recursion + memoisation."""
    if s1 == s2:
        return True
    if sorted(s1) != sorted(s2):  # prune: different character multisets
        return False

    n = len(s1)
    # Try every split position
    for i in range(1, n):
        # No swap: s1[0:i] ~ s2[0:i] and s1[i:] ~ s2[i:]
        if (_is_scramble(s1[:i], s2[:i]) and _is_scramble(s1[i:], s2[i:])):
            return True
        # Swap: s1[0:i] ~ s2[n-i:] and s1[i:] ~ s2[0:n-i]
        if (_is_scramble(s1[:i], s2[n-i:]) and _is_scramble(s1[i:], s2[:n-i])):
            return True
    return False

def scramble_string(str1: str, str2: str) -> bool:
    """Public wrapper – matches the Perl interface (returns True/False)."""
    if len(str1) != len(str2):
        return False
    return _is_scramble(str1, str2)