Catene di Gozinta

(Ispirato dal Progetto Euler # 606 )

Una catena gozinta per n è una sequenza in {1,a,b,...,n}cui ogni elemento divide correttamente il successivo. Ad esempio, ci sono otto distinte catene gozinta per 12:

{1,12}, {1,2,12}, {1,2,4,12}, {1,2,6,12}, {1,3,12}, {1,3,6,12}, {1,4,12} and {1,6,12}.

La sfida

Write a program or function that accepts a positive integer (n > 1) and outputs or returns all the distinct gozinta chains for the given number.

1. Order in the chains matters (ascending), order of the chains does not.
2. On the off-chance it exists, you cannot use a builtin that solves the challenge.
3. This is code-golf.

Edit: Removing 1 as a potential input.

Python 3, 68 65 bytes

Edit: -3 bytes thanks to @notjagan

f=lambda x:[y+[x]for k in range(1,x)if x%k<1for y in f(k)]or[[x]]

Try it online!

Explanation

Each gozinta chain consists of the number x at the end of the chain, with at least one divisor to the left of it. For each divisor k of x the chains [1,...,k,x] are distinct. We can therefore for each divisor k find all of its distinct gozinta chains and append x to the end of them, to get all distinct gozinta chains with k directly to the left of x. This is done recursively until x = 1 where [[1]] is returned, as all gozinta chains start with 1, meaning the recursion have bottomed out.

The code becomes so short due to Python list comprehension allowing double iteration. This means that the values found in f(k) can be added to the same list for all of the different divisors k.

Husk, 13 bytes

ufo=ḣ⁰…ġ¦ΣṖḣ⁰

A somewhat different approach to that of H.PWiz, though still by brute force. Try it online!

Explanation

The basic idea is to concatenate all subsequences of [1,...,n] and split the result into sublists where each element divides the next. Of these, we keep those that start with 1, end with n and contain no duplicates. This is done with the "rangify" built-in …. Then it remains to discard duplicates.

ufo=ḣ⁰…ġ¦ΣṖḣ⁰  Input is n=12.
           ḣ⁰  Range from 1: [1,2,..,12]
          Ṗ    Powerset: [[],[1],[2],[1,2],[3],..,[1,2,..,12]]
         Σ     Concatenate: [1,2,1,2,3,..,1,2,..,12]
       ġ¦      Split into slices where each number divides next: [[1,2],[1,2],[3],..,[12]]
 fo            Filter by
      …        rangified
   =ḣ⁰         equals [1,...,n].
u              Remove duplicates.

Jelly, 9 8 bytes

ÆḌ߀Ẏ;€ȯ

Try it online!

Uses a similar technique to my Japt answer, and therefore runs very quickly on larger test cases.

How it works

ÆḌ߀Ẏ;€ȯ    Main link. Argument: n (integer)
ÆḌ          Yield the proper divisors of n.
       ȯ    If there are no divisors, return n. Only happens when n is 1.
  ߀        Otherwise, run each divisor through this link again. Yields
            a list of lists of Gozinta chains.
    Ẏ       Tighten; bring each chain into the main list.
     ;€     Append n to each chain.

Mathematica, 77 bytes

FindPath[Graph@Cases[Divisors@#~Subsets~{2},{m_,n_}/;m∣n:>m->n],1,#,#,All]&

Forms a Graph where the vertices are the Divisors of the input #, and the edges represent proper divisibility, then finds All paths from the vertex 1 to the vertex #.

Jelly, 12 bytes

ŒPµḍ2\×ISµÐṀ

A monadic link accepting an integer and returning a list of lists of integers.

Try it online!

How?

We want all the sorted lists of unique integers between one and N such that the first is a one, the last is N, and all pairs divide. The code achieves this filter by checking the pair-wise division criteria is satisfied over the power-set of the range in question, but only picking those with maximal sums of incremental difference (the ones which both start with one and end with N will have a sum of incremental differences of N-1, others will have less).

ŒPµḍ2\×ISµÐṀ - Link: number N
ŒP           - power-set (implicit range of input) = [[1],[2],...,[N],[1,2],[1,3],...,[1,N],[1,2,3],...]
          ÐṀ - filter keep those for which the result of the link to the left is maximal:
  µ      µ   - (a monadic chain)
    2\       -   pairwise overlapping reduce with:
   ḍ         -     divides? (1 if so, 0 otherwise)
       I     -   increments  e.g. for [1,2,4,12] -> [2-1,4-2,12-4] = [1,2,8]
      ×      -   multiply (vectorises) (no effect if all divide,
             -                          otherwise at least one gets set to 0)
        S    -   sum         e.g. for [1,2,4,12] -> 1+2+8 = 11 (=12-1)

Japt, 17 bytes

⬣ßX m+S+UR÷ª'1

Test it online!

Weirdly, generating the output as a string was way easier than generating it as an array of arrays...

Explanation

 ⬠£  ßX m+S+URà ·  ª '1
Uâq mX{ßX m+S+UR} qR ||'1   Ungolfed
                            Implicit: U = input number, R = newline, S = space
Uâ                          Find all divisors of U,
  q                           leaving out U itself.
    mX{         }           Map each divisor X to
       ßX                     The divisor chains of X (literally "run the program on X")
          m    R              with each chain mapped to
           +S+U                 the chain, plus a space, plus U.
                  qR        Join on newlines.
                     ||     If the result is empty (only happens when there are no factors, i.e. U == 1)
                       '1     return the string "1".
                            Otherwise, return the generated string.
                            Implicit: output result of last expression

Mathematica, 60 bytes

Cases[Subsets@Divisors@#,x:{1,___,#}/;Divisible@@Reverse@{x}]&

Uses the undocumented multi-arg form of Divisible, where Divisible[n1,n2,...] returns True if n2∣n1, n3∣n2, and so on, and False otherwise. We take all Subsets of the list of Divisors of the input #, then return the Cases of the form {1,___,#} such that Divisible gives True for the Reversed sequence of divisors.

Haskell, 51 bytes

f 1=[[1]]
f n=[g++[n]|k<-[1..n-1],n`mod`k<1,g<-f k]

Recursively find gozinta chains of proper divisors and append n.

Try it online!

Haskell (Lambdabot), 92 85 bytes

x#y|x==y=[[x]]|1>0=(guard(mod x y<1)>>(y:).map(y*)<$>div x y#2)++x#(y+1)
map(1:).(#2)

Needs Lambdabot Haskell since guard requires Control.Monad to be imported. Main function is an anonymous function, which I'm told is allowed and it shaves off a couple of bytes.

Thanks to Laikoni for saving seven bytes.

Explanation:

Monads are very handy.

x # y

This is our recursive function that does all the actual work. x is the number we're accumulating over (the product of the divisors that remain in the value), and y is the next number we should try dividing into it.

 | x == y = [[x]]

If x equals y then we're done recursing. Just use x as the end of the current gozinta chain and return it.

 | 1 > 0 =

Haskell golf-ism for "True". That is, this is the default case.

(guard (mod x y < 1) >>

We're operating inside the list monad now. Within the list monad, we have the ability to make multiple choices at the same time. This is very helpful when finding "all possible" of something by exhaustion. The guard statement says "only consider the following choice if a condition is true". In this case, only consider the following choice if y divides x.

(y:) . map (y *) <$> div x y#2)

If y does divide x, we have the choice of adding y to the gozinta chain. In this case, recursively call (#), starting over at y = 2 with x equal to x / y, since we want to "factor out" that y we just added to the chain. Then, whatever the result from this recursive call, multiple its values by the y we just factored out and add y to the gozinta chain officially.

++

Consider the following choice as well. This simply adds the two lists together, but monadically we can think of it as saying "choose between doing this thing OR this other thing".

x # (y + 1)

The other option is to simply continue recursing and not use the value y. If y does not divide x then this is the only option. If y does divide x then this option will be taken as well as the other option, and the results will be combined.

map (1 :) . (# 2)

This is the main gozinta function. It begins the recursion by calling (#) with its argument. A 1 is prepended to every gozinta chain, because the (#) function never puts ones into the chains.

Haskell, 107 100 95 bytes

f n=until(all(<2).map head)(>>=h)[[n]]
h l@(x:_)|x<2=[l]|1<2=map(:l)$filter((<1).mod x)[1..x-1]

Maybe there is a better termination condition (tried something like

f n=i[[n]]
i x|g x==x=x|1<2=i$g x
g=(>>=h)

but it's longer). The check for 1 seems prudent as scrubbing repeat 1s or duplicates (nub not in Prelude) is more bytes.

Try it online.

JavaScript (Firefox 30-57), 73 bytes

f=n=>n>1?[for(i of Array(n).keys())if(n%i<1)for(j of f(i))[...j,n]]:[[1]]

Conveniently n%0<1 is false.

Jelly, 17 bytes

ḊṖŒP1ppWF€ḍ2\Ạ$Ðf

Try it online!

Mathematica, 104 bytes

(S=Select)[Rest@S[Subsets@Divisors[t=#],FreeQ[#∣#2&@@@Partition[#,2,1],1>2]&],First@#==1&&Last@#==t&]&

Mathematica, 72 bytes

Cases[Subsets@Divisors@#,{1,___,#}?(And@@BlockMap[#∣#2&@@#&,#,2,1]&)]&

Explanation

Divisors@#

Find all divisors of the input.

Subsets@ ...

Generate all subsets of that list.

Cases[ ... ]

Pick all cases that match the pattern...

{1,___,#}

Beginning with 1 and ending with <input>...

?( ... )

and satisfies the condition...

And@@BlockMap[#∣#2&@@#&,#,2,1]&

The left element divides the right element for all 2-partitions of the list, offset 1.

TI-BASIC, 76 bytes

Input N
1→L1(1
Repeat Ans=2
While Ans<N
2Ans→L1(1+dim(L1
End
If Ans=N:Disp L1
dim(L1)-1→dim(L1
L1(Ans)+L1(Ans-(Ans>1→L1(Ans
End

Explanation

Input N                       Prompt user for N.
1→L1(1                        Initialize L1 to {1}, and also set Ans to 1.

Repeat Ans=2                  Loop until Ans is 2.
                              At this point in the loop, Ans holds the
                              last element of L1.

While Ans<N                   While the last element is less than N,
2Ans→L1(1+dim(L1              extend the list with twice that value.
End

If Ans=N:Disp L1              If the last element is N, display the list.

dim(L1)-1→dim(L1              Remove the last element, and place the new
                              list size in Ans.

L1(Ans)+L1(Ans-(Ans>1→L1(Ans  Add the second-to-last element to the last
                              element, thereby advancing to the next
                              multiple of the second-to-last element.
                              Avoid erroring when only one element remains
                              by adding the last element to itself.

End                           When the 1 is added to itself, stop looping.

I could save another 5 bytes if it's allowed to exit with an error instead of gracefully, by removing the Ans>1 check and the loop condition. But I'm not confident that's allowed.

Mathematica 86 77 Bytes

Select[Subsets@Divisors@#~Cases~{1,___,#},And@@BlockMap[#∣#2&@@#&,#,2,1]&]&

Brute force by the definition.

Wishing there was a shorter way to do pairwise sequential element comparison of a list.

Thanks to @Jenny_mathy and @JungHwanMin for suggestions saving 9 bytes

Husk, 17 16 bytes

-1 byte, thanks to Zgarb

foEẊ¦m`Je1⁰Ṗthḣ⁰

Try it online!

PHP 147 141

Edited to remove a redundant test

function g($i){$r=[[1]];for($j=2;$j<=$i;$j++)foreach($r as$c)if($j%end($c)<1&&$c[]=$j)$r[]=$c;foreach($r as$c)end($c)<$i?0:$R[]=$c;return$R;}

Explained:

function g($i) {

15 chars of boilerplate :(

    $r = [[1]];

Init the result set to [[1]] as every chain starts with 1. This also leads to support for 1 as an input.

    for ($j = 2; $j <= $i; $j++) {
        foreach ($r as $c) {
            if ($j % end($c) < 1) {
                $c[] = $j;
                $r[] = $c;
            }
        }
    }

For every number from 2 to $i, we're going to extend each chain in our set by the current number if it gozinta, then, add the extended chain to our result set.

    foreach ($r as $c) {
        end($c) < $i ? 0 : $R[] = $c;
    }

Filter out our intermediate chains that didn't make it to $i

    return $R;
}

10 chars of boilerplate :(

Mathematica

f[1] = {{1}};
f[n_] := f[n] = Append[n] /@ Apply[Join, Map[f, Most@Divisors@n]]

Answer is cached for additional calls.