Task — Cute List

You are given an integer, 0 < $n <= 15. Write a script to find the number of orderings of numbers that form a cute list.

With an input @list = (1, 2, 3, .. $n) for positive integer $n, an ordering of @list is cute if for every entry, indexed with a base of 1:

• $list[$i] is evenly divisible by $i, or
• $i is evenly divisible by $list[$i]

Examples

Example 1
Input: $n = 2
Output: 2
Since $n = 2, the list can be made up of two integers 
only i.e. 1 and 2. Therefore we can have two lists i.e. 
(1, 2) and (2, 1).
@list = (1,2) is cute since $list[1] = 1 is divisible 
by 1 and $list[2] = 2 is divisible by 2.

Analysis

The first solution that comes to mind is to generate all the permutations of 1 .. $n, and check them all for cuteness. It tried that, but once I got to order 12 it was taking longer to compute than it took for me to eat my lunch, so I decided to try a different tack.

I wrote a recursive subroutine - I called it find_cute - that starts with an incomplete cute list and adds one more element. Suppose we're adding the 6th element in an order 12 list. There are a number of options for this element: it could be 1, 2 or 3 because those are factors of 6, and it could be 6 or 12 because these are multiples of 6 - but it can't be any of these if they are already in use for the 5 preceding elements.

If I do find a valid element - or several - I add it to the list and recursively call find_cute - maybe several times - to get the next element. If find_cute successfully gets all 12 elements filled then we have a solution.

If I've done this correctly there are 24679 possible cute lists of where $n == 15.

Try it 

#!/usr/bin/perl

# Peter Campbell Smith - 2022-11-14
# PWC 191 task 1

use v5.28;
use utf8;
use warnings;

my ($n, @perm, $nn, $x, $cute);

# loop over possible values of $n
for $nn (1 .. 15) {
    @perm = (0);
    $n = $nn;
    $cute = 0;
    @perm = find_cute(@perm);
    shift @perm;
    say qq[cute[$nn] = $cute];
}

sub find_cute {   # (@perm)

    # finds all the possible cute sublists comprising @perm and one additional digit
    # or returns if the list is complete
    
    my ($next_index, @perm, $j, $i, @used);
    
    # initialise
    @perm = @_;
    $next_index = scalar(@perm);
    
    # if we have enough digits, increement the cute count and return
    if ($next_index > $n) {
        $cute ++;
        return;
    }

    # set $used[$i] to 1 if $i has already been used in the string
    for $i (1 .. $n) {
        $used[$i] = 0;
    }
    for $i (1 .. $next_index) {
        if (defined($perm[$i])) {
            $used[$perm[$i]] = 1;
        }
    }

    # check whether adding each unused factor and multiple of the index will work as the next element
    for $j (1 .. $n) {
        if (not $used[$j] and ($next_index % $j == 0 or $j % $next_index == 0)) {
            find_cute(@perm, $j);               
        }
    }   
}

Output

Input:  $n = 1
Output: 1

Input:  $n = 2
Output: 2

Input:  $n = 3
Output: 3

Input:  $n = 4
Output: 8

Input:  $n = 5
Output: 10

Input:  $n = 6
Output: 36

Input:  $n = 7
Output: 41

Input:  $n = 8
Output: 132

Input:  $n = 9
Output: 250

Input:  $n = 10
Output: 700

Input:  $n = 11
Output: 750

Input:  $n = 12
Output: 4010

Input:  $n = 13
Output: 4237

Input:  $n = 14
Output: 10680

Input:  $n = 15
Output: 24679