Task — Beautiful arrangement

You are given a positive integer, $n. Write a script to return the number of beautiful arrangements that you can construct. A permutation of n integers, 1-indexed, is considered a beautiful arrangement if for every $i == (1 .. $n) either of the following is true:

1. $perm[$i] is divisible by $i
2. $i is divisible by $perm[!i]

Examples

Example 1
Input: $n = 2
Output: 2
1st arrangement: [1, 2]
    perm[1] is divisible by i = 1
    perm[2] is divisible by i = 2
2nd arrangement: [2, 1]
    perm[1] is divisible by i = 1
    i=2 is divisible by perm[2] = 1

Example 2
Input: $n = 1
Output: 1

Example 3
Input: $n = 10
Output: 700

Analysis

The obvious way to meet this challege is my solution 1, which simply takes all the permutations of 1 .. $n and tests them for being beautiful. It comes up with the same answer as the provided example for $n == 10 in 25 seconds.

For $n in the range 0-8 it takes less than a second, for $n == 9 it takes 3 seconds and for $n == 11 it takes 277 seconds - nearly 5 minutes.

In my solution I have included a couple of optimisations:

• If $i == 1 or $i == $perm[$i] it is not necessary to apply the two conditions, and
• only one of the two conditions is relevant depending on whether $i is greater or less than $perm[$i].

But even so, its execution time rises rather alarmingly as $n increases.

So is there a faster way? I can't immediately think of a way that doen't involve checking every permutation, but I can make a modest improvement - my solution 2.

The basis of solution 2 is that for each $i there are only a few possible values of $perm[$i], which are:

• $i
• any multiples of $i which are <= $n
• any integer divisors of $i including 1

So for example for $n == 10 the only beautiful possibilities are:

$i	$perm[$i]
1	1 .. 10
2	1, 2, 4, 6, 8, 10
3	1, 3, 6, 9
4	1, 2, 4, 8
5	1, 5, 10
6	1, 2, 3, 6
7	1, 7
8	1, 2, 4, 8
9	1, 3, 9
10	1, 2, 5, 10

So when checking a permutation, let's start by checking $perm[7], because that has only two possible values - 1 or 7 - so 80% of perms can be discarded without looking at any further components of the perm.

My solution 2 therefore creates an order for checking the beautifulness of each perm by checking the components in the increasing order of the number of beautiful possibilities: so for
$n == 10 it checks in the order 7, 5, 9, 3, 4, 6, 8, 10, 2. It doesn't need to check 1, because any number is divisible by 1 and 1 can therefore appear anywhere in @perm, and it doesn't need to check the elements where $perm[$i] == $i.

I had rather hoped for a substantial increase in speed by doing that, but in fact it only reduces the time by around 10%. I am guessing that's because the generation of the perms is what takes the bulk of the time.

Try it 

I haven't provided a 'try it' for this challenge because the solutions for 2 to 11 are shown in my Output section and any others will take too long for a web page.

⤡

#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2024-12-16
use utf8;     # Week 300 - task 1 - Beautiful arrangement
use warnings; # Peter Campbell Smith
use Algorithm::Combinatorics 'permutations';
binmode STDOUT, ':utf8';

for (2 .. 11) {
    beautiful_arrangement1($_);
    beautiful_arrangement2($_);
}

sub beautiful_arrangement1 {
    
    my ($n, @array, $iter, $next, $i, $start, @order, @possible, $beautiful);
    
    # initialise
    $n = shift;
    $beautiful = 0;
    $start = time();
    push(@array, $_) for 1 .. $n;
    
    # loop over perms
    $iter = permutations(\@array);
    PERM: while ($next = $iter->next) {
        for $i (1 .. $n) {
            
            # test for ugliness
            unless ($i == $next->[$i - 1]) {
                next PERM unless $i > $next->[$i - 1] 
                    ? $i % $next->[$i - 1] == 0 
                    : $next->[$i - 1] % $i == 0;
            }
        }
        
        # not ugly
        $beautiful ++;
    }
    say qq[\nInput:  \$n = $n];
    say qq[Output1: $beautiful (] . (time() - $start) . qq[ secs)];
}

sub beautiful_arrangement2 {
    
    my ($i, $j, $k, $start, @count, $n, $iter, $next, $m, $beautiful, @possible,
        @order, @array);
    
    # initialise
    $n = shift;
    $beautiful = 0;
    $start = time();
    
    # find possible values of each $array[$i]
    for $i (1 .. $n) {  
        $possible[$i] = '~';
        for $j (1 .. 999) {
            
            # multiples
            if ($i * $j <= $n) {
                $possible[$i] .= $i * $j . '~';
            }
            
            # divisors
            if ($j > 1 and $i / $j >= 1 and $i % $j == 0) {
                $possible[$i] .= $i / $j . '~';
            }
        }
    }
    
    # $count[$i] is the no of possible values at $array[$i]
    for $i (1 .. $n) {
        $count[$i] = ($possible[$i] =~ s|~|~|g) - 1;
    }
    
    # @order is the hardest to easiest order to fill
    for $i (1 .. $n) {
        for $j (1 .. $n) {
            if ($count[$j] == $i) {
                push @order, $j;
            }
        }
    }
    
    # now start as before
    push(@array, $_) for 1 .. $n;
    
    # loop over perms
    $iter = permutations(\@array);
    PERM: while ($next = $iter->next) {
        for $k (0 .. $n - 1) {
            
            # test for ugliness in order of probability
            $i = $order[$k];
            $m = $next->[$i - 1];
            unless ($i == 1 or $i == $m) {
                next PERM unless $i > $m ? $i % $m == 0 : $m % $i == 0;
            }
        }
        
        # not ugly
        $beautiful ++;
    }
    
    say qq[Output2: $beautiful (] . (time() - $start) . qq[ secs)];
}

Output

Input:  $n = 2
Output1: 2 (0 secs)
Output2: 2 (0 secs)

Input:  $n = 3
Output1: 3 (0 secs)
Output2: 3 (0 secs)

Input:  $n = 4
Output1: 8 (0 secs)
Output2: 8 (0 secs)

Input:  $n = 5
Output1: 10 (0 secs)
Output2: 10 (0 secs)

Input:  $n = 6
Output1: 36 (0 secs)
Output2: 36 (0 secs)

Input:  $n = 7
Output1: 41 (0 secs)
Output2: 41 (0 secs)

Input:  $n = 8
Output1: 132 (0 secs)
Output2: 132 (0 secs)

Input:  $n = 9
Output1: 250 (3 secs)
Output2: 250 (2 secs)

Input:  $n = 10
Output1: 700 (25 secs)
Output2: 700 (23 secs)

Input:  $n = 11
Output1: 750 (277 secs)
Output2: 750 (255 secs)