Chaînes de Gozinta

(Inspiré du projet Euler n ° 606 )

Une chaîne de gozinta pour n est une séquence {1,a,b,...,n}où chaque élément divise correctement le suivant. Par exemple, il y a huit chaînes gozinta distinctes pour 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}.

Le défi

Ecrivez un programme ou une fonction qui accepte un entier positif ( n > 1) et affiche ou renvoie toutes les chaînes gozinta distinctes pour le nombre donné.

1. L'ordre dans les chaînes est important (croissant), l'ordre des chaînes ne l'est pas.
2. Au hasard, il existe, vous ne pouvez pas utiliser une fonction intégrée qui résout le problème.
3. C'est du code-golf .

Edit: Supprimer 1comme entrée potentielle.

Python 3 , 68 65 octets

Edit: -3 octets grâce à @notjagan

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

Essayez-le en ligne!

Explication

Chaque chaîne de gozinta se compose du nombre xà la fin de la chaîne, avec au moins un diviseur à la gauche de celle-ci. Pour chaque diviseur kdes xchaînes [1,...,k,x]sont distinctes. On peut donc pour chaque diviseur ktrouver l' ensemble de ses différentes chaînes gozinta et append xà la fin d'entre eux, pour obtenir toutes les différentes chaînes gozinta avec kdirectement à la gauche de x. Ceci est fait de manière récursive jusqu'à ce x = 1que [[1]]soit retourné où , toutes les chaînes de gozinta commençant par 1, ce qui signifie que la récursivité est au plus bas .

Le code devient tellement court en raison de la compréhension de la liste Python permettant une double itération. Cela signifie que les valeurs trouvées dans f(k)peuvent être ajoutées à la même liste pour tous les diviseurs différents k.

Coque , 13 octets

ufo=ḣ⁰…ġ¦ΣṖḣ⁰

Une approche quelque peu différente de celle de H.PWiz , mais toujours par force brute. Essayez-le en ligne!

Explication

L'idée de base est de concaténer toutes les sous-séquences de [1,...,n]et de scinder le résultat en sous-listes, chaque élément se divisant le suivant. Parmi ceux-ci, nous conservons ceux qui commencent par 1, se terminent net ne contiennent aucun doublon. Ceci est fait avec le "rangify" intégré …. Ensuite, il reste à éliminer les doublons.

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.

Gelée , 9 à 8 octets

ÆḌ߀Ẏ;€ȯ

Essayez-le en ligne!

Utilise une technique similaire à ma réponse Japt et s'exécute donc très rapidement sur les cas de test plus volumineux.

Comment ça marche

ÆḌ߀Ẏ;€ȯ    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 octets

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

Les formes a Graphoù les sommets sont les Divisorsentrées #et où les arêtes représentent la divisibilité appropriée, puis recherche des Allchemins allant du sommet 1au sommet #.

Gelée , 12 octets

ŒPµḍ2\×ISµÐṀ

Un lien monadique acceptant un entier et renvoyant une liste de listes d'entiers.

Essayez-le en ligne!

Comment?

Nous voulons toutes les listes triées d'entiers uniques compris entre un et N tels que la première soit un, la dernière est N et que toutes les paires se divisent. Le code réalise ce filtre en vérifiant que le critère de division par paires est satisfait sur la puissance de la plage en question, mais en sélectionnant uniquement celles avec les sommes maximales de différence incrémentielle (celles qui commencent par un et se terminent par N auront une somme de différences incrémentielles de N-1, les autres auront moins).

Œ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 octets

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

Testez-le en ligne!

Bizarrement, générer la sortie sous forme de chaîne était beaucoup plus simple que de le générer sous forme de tableau de tableaux ...

Explication

 ⬠£  ß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 octets

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

Utilise le formulaire multi-arg non documentée de Divisible, où les Divisible[n1,n2,...]rendements Truesi n2∣n1, n3∣n2et ainsi de suite, et Falseautrement. Nous prenons toute Subsetsla liste des Divisorsentrées #, puis nous retournons Casesla forme {1,___,#}telle qu'elle Divisibledonne Truela Reverseséquence d de diviseurs.

Haskell, 51 octets

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

Trouvez récursivement les chaînes de gozinta de diviseurs appropriés et ajoutez-les n.

Essayez-le en ligne!

Haskell (Lambdabot), 92 85 octets

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)

A besoin de Lambdabot Haskell car guardnécessite Control.Monadd'être importé. La fonction principale est une fonction anonyme, qui, me dit-on, est autorisée et supprime quelques octets.

Merci à Laikoni pour avoir économisé sept octets.

Explication:

Les monades sont très utiles.

x # y

C'est notre fonction récursive qui fait tout le travail réel. xest le nombre sur lequel nous accumulons (le produit des diviseurs qui restent dans la valeur), et yest le prochain nombre que nous devrions essayer de diviser en ce nombre.

 | x == y = [[x]]

Si xégaux, yalors nous avons terminé récursif. Utilisez simplement xla fin de la chaîne gozinta actuelle et renvoyez-la.

 | 1 > 0 =

Haskell golf-ism pour "True". C'est le cas par défaut.

(guard (mod x y < 1) >>

Nous opérons maintenant dans la liste de la monade. Dans la monade de liste, nous avons la possibilité de faire plusieurs choix en même temps. Ceci est très utile pour trouver "tout ce qui est possible" de quelque chose par épuisement. L’ guardénoncé dit "n’envisagez le choix suivant que si une condition est vraie". Dans ce cas, ne considérez le choix suivant que si ydivise x.

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

Si ydivise x, nous avons le choix d'ajouter yà la chaîne de gozinta. Dans ce cas, appelez récursivement (#), en partant y = 2de xzéro x / y, puisque nous voulons "factoriser" ce que ynous venons d'ajouter à la chaîne. Ensuite, quel que soit le résultat de cet appel récursif, multipliez ses valeurs par celles que ynous venons de factoriser et ajoutons yofficiellement à la chaîne de gozinta.

++

Considérez également le choix suivant. Cela ajoute simplement les deux listes ensemble, mais monadiquement, nous pouvons penser que "choisir entre faire cette chose OU cette autre chose".

x # (y + 1)

L'autre option consiste simplement à continuer à récursir et à ne pas utiliser la valeur y. Si yne divise pas xalors c'est la seule option. Si ydivise xalors cette option sera prise ainsi que l'autre option, et les résultats seront combinés.

map (1 :) . (# 2)

C'est la fonction principale de gozinta. Il commence la récursion en appelant (#)avec son argument. A 1est ajouté à chaque chaîne gozinta, car la (#)fonction ne les met jamais dans les chaînes.

Haskell, 107 100 95 octets

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]

Peut-être y at-il une meilleure condition de résiliation (essayé quelque chose comme

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

mais c'est plus long). La vérification 1semble prudente, car le nettoyage des répétitions 1ou des doublons ( nubpas dans Prelude) correspond à plus d'octets.

Essayez-le en ligne.

JavaScript (Firefox 30-57), 73 octets

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

Idéalement, n%0<1c'est faux.

Gelée , 17 octets

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

Essayez-le en ligne!

Mathematica, 104 octets

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

Mathematica, 72 octets

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

Explication

Divisors@#

Trouver tous les diviseurs de l'entrée.

Subsets@ ...

Générez tous les sous-ensembles de cette liste.

Cases[ ... ]

Choisissez tous les cas qui correspondent au motif ...

{1,___,#}

Commençant par 1 et se terminant par <input>...

?( ... )

et satisfait à la condition ...

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

L'élément de gauche divise l'élément de droite pour toutes les 2 partitions de la liste, décalage 1.

TI-BASIC, 76 octets

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

Explication

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.

Je pourrais économiser 5 octets supplémentaires s'il est autorisé à quitter avec une erreur plutôt qu'en douceur, en supprimant le contrôle Ans> 1 et la condition de boucle. Mais je ne suis pas convaincu que c'est permis.

Mathematica 86 77 octets

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

Force brute selon la définition.

Souhaitant qu'il y ait un moyen plus court de faire la comparaison séquentielle par éléments d'une liste.

Merci à @Jenny_mathy et à @JungHwanMin pour leurs suggestions permettant d’économiser 9 octets.

Husk , 17 à 16 octets

-1 octet, merci à Zgarb

foEẊ¦m`Je1⁰Ṗthḣ⁰

Essayez-le en ligne!

PHP 147 141

Édité pour supprimer un test redondant

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;}

A expliqué:

function g($i) {

15 caractères du passe-partout :(

    $r = [[1]];

Initialisez le jeu de résultats à [[1]]chaque chaîne commençant par 1. Ceci conduit également à prendre en charge 1 comme entrée.

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

Pour chaque nombre de 2 à $i, nous allons étendre chaque chaîne dans notre série par le nombre actuel si elle gozinta , puis, ajoutez la chaîne étendue à notre jeu de résultats.

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

Filtrer nos chaînes intermédiaires qui ne l'ont pas fait $i

    return $R;
}

10 caractères du passe-partout :(

Mathematica

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

La réponse est mise en cache pour des appels supplémentaires.