Weekly Challenge: Secret Words

Weekly Challenge 388

Each week Mohammad S. Anwar sends out The Weekly Challenge, a chance for all of us to come up with solutions to two weekly tasks. My solutions are written in Python first, and then converted to Perl. Unless otherwise stated, Copilot (and other AI tools) have NOT been used to generate the solution. It's a great way for us all to practice some coding.

Challenge, My solutions

Task 1: Dyck Words

A Dyck Word of order $n is a string of length 2 × $n consisting of $n U (Up) characters and $n D (Down) characters such that no initial prefix of the string contains more Ds than Us.

Write a script to return a list of all valid Dyck words of length 2 × $n, sorted in lexicographical (alphabetical) order.

My solution

For this task, I have a recursive function called dyck_words. It takes n as an input, as well as dyck which is the word found so far. On the first call dyck is set to None (undef in Perl).

The first thing I do is set dyck to "U" if it is None (i.e. the first call of the recursive function). The first move must be up. If the length of dyck is 2 × n, I return that back as a list as it is a valid solution.

def dyck_words(n: int, dyck: str | None = None) -> list[str]:
    if dyck is None:
        dyck = "U"

    if len(dyck) == 2 * n:
        return [dyck]

The recursive part of the function starts by counting how many steps up we are. This is stored in the variable steps, by counting the number of ups and subtracting the number of downs.

    steps = dyck.count("U") - dyck.count("D")
    solutions = []

If the steps is greater than zero, the next move can be down. I call the function again adding D to the dyck variable. If steps is less than the remaining characters left to fill 2 × n - len(dyck), it is possible to move up as there are enough down positions remaining to get back to zero. In the case, I call the function again adding U to the dyck variable.

Finally I return all valid solutions up the recursive chain. As the down is called before the up, the list will already be sorted alphabetically.

    if steps > 0:
        down = dyck_words(n, f"{dyck}D")
        if down:
            solutions.extend(down)
    if steps < 2 * n - len(dyck):
        up = dyck_words(n, f"{dyck}U")
        if up:
            solutions.extend(up)

    return solutions

Examples

$ ./ch-1.py 1
("UD")

$ ./ch-1.py 2
("UDUD", "UUDD")

$ ./ch-1.py 3
("UDUDUD", "UDUUDD", "UUDDUD", "UUDUDD", "UUUDDD")

$ ./ch-1.py 4
("UDUDUDUD", "UDUDUUDD", "UDUUDDUD", "UDUUDUDD", "UDUUUDDD", "UUDDUDUD", "UUDDUUDD", "UUDUDDUD", "UUDUDUDD", "UUDUUDDD", "UUUDDDUD", "UUUDDUDD", "UUUDUDDD", "UUUUDDDD")

$ ./ch-1.py 0
()

Task 2: Secret Santa

A company with $n employees is running a Secret Santa exchange. Each employee buys one gift and receives one gift.

Write a script to return the total number of valid gift assignments where no employee receives the gift they originally bought (i.e., employee $i must not be assigned gift $i).

My solution

Completing this challenge, is an example of trial and error. The first thing I looked for was a pattern. If n is 5, the answer is 44 (prime factors 2 × 2 × 11), so that wasn't the answer.

The next iteration was to write a recursive function that found all circular references. That worked, but didn't produce the desired results.

I then realized that for this task, the links didn't need to be circular. In other words, if you have four people, the first two could swap gifts and the other two can swap gifts.

In the end I went for a solution that brute forces the answer. I calculate all permutations for 0 to n-1 and count the rows where a person is not gifting it to themselves.

from itertools import permutations

def secret_santa(people: int) -> int:
    count = 0

    for p in permutations(range(people)):
        if not any(i == j for i, j in enumerate(p)):
            count += 1

    return count

The Perl solution follows the same logic.

use Algorithm::Combinatorics 'permutations';
use List::Util 'none';

sub main ($people) {
    my $count  = 0;
    my @people = ( 0 .. $people - 1 );

    my $permutations = permutations( \@people );
    while ( my $p = $permutations->next() ) {
        if ( none { $p->[$_] eq $_ } ( 0 .. $people - 1 ) ) {
            $count++;
        }
    }

    say $count;
}

The drawback with this method is that if n is larger than 10, it can take a little while to produce a result. On my home PC, it took 24 seconds to find with 11 people, there are 14,684,570 possible combinations.

Examples

$ ./ch-2.py 1
0

$ ./ch-2.py 2
1

$ ./ch-2.py 3
2

$ ./ch-2.py 4
9

$ ./ch-2.py 5
44