TL;DR

On with TASK #2 from The Weekly Challenge #191. Enjoy!

The challenge

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, either

1) $list[$i] is evenly divisible by $i
or
2) $i is evenly divisible by $list[$i]

Example

Input: $n = 2
Ouput: 2

Since $n = 2, the list can be made up of two integers only i.e. 1 and 2.
Therefore we can have two list 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.

The questions

I guess the input says it all (apart, maybe, what is an ordering of a list, but it seems pretty clear).

The solution

The brute force approach in this case would have us enumerate all possible permutations and filter the ones that comply with the definition.

Problem is that the number of permutations literally goes factorially with the number of items. That is, a starting list with 15 items would include $15! = 1307674368000 \approx 1.31 \cdot 10^{12}$ permutations, which is a tad too many.

On the other hand, it’s possible to do a lot of pruning in our search by considering that anything of the type x 3 y z ... is not going anywhere, because neither 2 divides 3, nor the contrary. Hence, there’s no point considering all those permutations (or generating them, for what matters).

This leads us to the following recursive implementation, which bails out early as soon as it finds something fishy, avoiding to expand all sub-permutations that are not worth the effort.

#!/usr/bin/env perl
use v5.24;
use warnings;
use experimental 'signatures';
no warnings 'experimental::signatures';

say cute_list(shift // 2);

sub cute_list ($n) {
   state sub cute_list_r ($count, $i, @items) {
      ++$count unless @items;
      my @pre = ();
      while (@items) {
         my $v = shift @items;
         if (! ($v % $i && $i % $v)) {
            $count = __SUB__->($count, $i + 1, @pre, @items);
         }
         push @pre, $v;
      }
      return $count;
   };
   cute_list_r(0, 1, 1 .. $n);
}

It’s been an interesting occasion to use Lexical Subroutines! And __SUB__!

The same approach can be easily translated in Raku:

#!/usr/bin/env raku
use v6;
sub MAIN (Int $n where 0 < * <= 15 = 2) { put cute-list($n) }

sub cute-list ($n) {
   sub cute-list-r ($count is copy, $i, *@items) {
      ++$count unless @items;
      my @pre;
      while @items {
         my $v = @items.shift;
         if ($v %% $i) || ($i %% $v) {
            $count = cute-list-r($count, $i + 1, @pre.Slip, @items.Slip);
         }
         @pre.push: $v;
      }
      return $count;
   };
   return cute-list-r(0, 1, 1 .. $n);
}

Stay safe!