Facteurs d'Anagramme

19

Dans un épisode récent de QI , les 5 premiers multiples de 142857 ont été décrits comme des anagrammes du nombre original. Bien sûr, toute personne ayant plus qu'une connaissance passagère de ce nombre saura que ces nombres sont en fait cycliques, pas seulement des anagrammes. Mais cela m'a fait réfléchir.

Veuillez écrire un programme ou une fonction qui produit tous les nombres de six chiffres ou moins qui ont un facteur approprié qui est une anagramme de lui-même. La liste doit commencer par les numéros suivants:

3105    (divisible by 1035)
7128    (divisible by 1782)
7425    (divisible by 2475)
8316    (divisible by 1386)
8712    (divisible by 2178)
9513    (divisible by 1359)
9801    (divisible by 1089)

Si vous préférez, vous pouvez trouver des nombres qui ont une anagramme qui est un facteur approprié du nombre, mais veillez à exclure les zéros de tête de vos anagrammes.

C'est le golf de code, donc le code le plus court en octets qui ne casse aucune faille standard gagne.

Neil
la source
Si on leur laisse suffisamment de temps, nos programmes peuvent-ils produire des numéros à plus de 6 chiffres?
Blue
1
Pourriez-vous s'il vous plaît poster la liste?
xnor
@muddyfish Oui, ce serait acceptable, tant qu'il n'omet aucun chiffre ou ne produit pas de chiffres incorrects au fur et à mesure.
Neil
@xnor Je n'ai pas encore pris la peine de calculer la liste entière, bien que je ne m'attende à aucun litige à ce sujet.
Neil
1
J'ai fait une collerette de ma sortie (j'espère correcte).
Greg Martin

Réponses:

6

Mathematica (environnement REPL), 75 74 octets

Merci à ngenisis d'avoir resserré cela d'un octet!

Select[Range[10!],Most@#~MemberQ~Last@#&[Sort/@IntegerDigits@Divisors@#]&]

Sort/@IntegerDigits@Divisors@#produit une liste triée de chiffres pour chaque diviseur de son argument; le numéro d'entrée est lui-même un diviseur, donc sa liste triée de chiffres est la dernière. Most@#~MemberQ~Lastdétecte si cette dernière liste triée de chiffres apparaît également dans la liste avant le dernier élément. Et Select[Range[10!],...]ne conserve que les nombres entiers jusqu'à 3 628 800 qui réussissent ce test (cette limite choisie car elle est inférieure d'un octet à 10 6 ). Il s'exécute en environ 5 minutes sur mon ordinateur, donnant une liste de 494 numéros, dont le plus grand est 3 427 191; il y a 362 nombres jusqu'à 10 6 , dont le larget est 989 901.

Greg Martin
la source
Eh bien, ce n'est pas si curieux: 857142 et 571428 sont deux nombres avec deux anagrammes de diviseurs appropriés évidents.
Neil
En fait, 857142 a trois anagrammes de diviseurs appropriés, n'est-ce pas?
Neil
on dirait que tu as raison!
Greg Martin
Vous pouvez enregistrer un octet à l'aide de IntegerDigits@Divisors@#.
ngenisis
3

Gelée , 12 octets

ÆḌṢ€ċṢ
ȷ6ÇÐf

Essayez-le en ligne! (utilise cinq chiffres ou moins en raison du délai de TIO)

La vérification

$ time jelly eun 'ÆḌṢ€ċṢ¶ȷ6ÇÐf'
[3105, 7128, 7425, 8316, 8712, 9513, 9801, 30105, 31050, 37125, 42741, 44172, 67128, 70416, 71208, 71253, 71280, 71328, 71928, 72108, 72441, 74142, 74250, 74628, 74925, 78912, 79128, 80712, 81816, 82755, 83160, 83181, 83916, 84510, 85725, 86712, 87120, 87132, 87192, 87912, 89154, 90321, 90801, 91152, 91203, 93513, 94041, 94143, 95130, 95193, 95613, 95832, 98010, 98091, 98901, 251748, 257148, 285174, 285714, 300105, 301050, 307125, 310284, 310500, 321705, 341172, 342711, 370521, 371142, 371250, 371628, 371925, 372411, 384102, 403515, 405135, 410256, 411372, 411723, 415368, 415380, 415638, 419076, 419580, 420741, 421056, 423711, 425016, 427113, 427410, 427491, 428571, 430515, 431379, 431568, 435105, 436158, 441072, 441720, 449172, 451035, 451305, 458112, 461538, 463158, 471852, 475281, 501624, 502416, 504216, 512208, 512820, 517428, 517482, 517725, 525771, 527175, 561024, 562104, 568971, 571428, 571482, 581124, 589761, 615384, 619584, 620379, 620568, 623079, 625128, 641088, 667128, 670416, 671208, 671280, 671328, 671928, 672108, 678912, 679128, 681072, 691872, 692037, 692307, 704016, 704136, 704160, 704196, 705213, 705321, 706416, 711342, 711423, 712008, 712080, 712503, 712530, 712800, 713208, 713280, 713328, 713748, 714285, 716283, 717948, 719208, 719253, 719280, 719328, 719928, 720108, 720441, 721068, 721080, 721308, 721602, 723411, 724113, 724410, 724491, 728244, 730812, 731892, 732108, 741042, 741285, 741420, 742284, 742500, 744822, 746280, 746928, 749142, 749250, 749628, 749925, 753081, 754188, 755271, 760212, 761082, 761238, 761904, 771525, 772551, 779148, 783111, 786912, 789120, 789132, 789192, 789312, 790416, 791208, 791280, 791328, 791928, 792108, 798912, 799128, 800712, 806712, 807120, 807132, 807192, 807912, 814752, 816816, 818160, 818916, 820512, 822744, 823716, 824472, 825174, 825714, 827550, 827658, 827955, 829467, 830412, 831117, 831600, 831762, 831810, 831831, 839160, 839181, 839916, 840510, 841023, 841104, 843102, 845100, 845910, 847422, 851148, 851220, 851742, 852471, 857142, 857250, 857628, 857925, 862512, 862758, 862947, 865728, 866712, 867120, 867132, 867192, 867912, 871200, 871320, 871332, 871425, 871920, 871932, 871992, 874125, 879120, 879132, 879192, 879912, 888216, 891054, 891540, 891594, 891723, 892755, 894510, 895725, 899154, 900801, 901152, 903021, 903210, 903231, 904041, 908010, 908091, 908901, 909321, 910203, 911043, 911358, 911520, 911736, 911952, 912030, 912093, 912303, 916083, 920241, 920376, 923076, 923580, 925113, 925614, 930321, 931176, 931203, 933513, 934143, 935130, 935193, 935613, 935832, 940410, 940491, 941430, 941493, 941652, 943137, 943173, 951300, 951588, 951930, 951993, 952380, 956130, 956193, 956613, 958032, 958320, 958332, 958392, 958632, 958716, 959832, 960741, 962037, 962307, 970137, 971028, 980100, 980910, 980991, 989010, 989091, 989901]

real    2m10.819s
user    2m10.683s
sys     0m0.192s

Comment ça fonctionne

ȷ6ÇÐf   Main link. No arguments.

ȷ6      Yield 1e6 = 1,000,000.
  ÇÐf   Filter; keep numbers in [1, ..., 1e6] for which the helper link returns
        a truthy value.


ÆḌṢ€ċṢ  Helper link. Argument: n

ÆḌ      Compute all proper divisors of n.
  Ṣ€    Sort each proper divisor's digits.
     Ṣ  Sort n's digits.
   ċ    Count the occurrences of the result to the right in the result to the left.
Dennis
la source
1
En raison de ce commentaire, vous pouvez faire encore plus lentement ÆḌṢ€ċṢµȷ#pendant 10. Il a fallu environ 27 minutes pour fonctionner sur un noyau i7 (pas sur unix, pas sympa time); le résultat le plus important a été 6671928.
Jonathan Allan
Je commence à penser que vous modifiez Jelly par question 😏
Albert Renshaw
3

Brachylog , 12 octets

ℕf{k∋p.!}?ẉ⊥

Essayez-le en ligne!

Cependant, cela peut expirer avant d'imprimer quoi que ce soit (et si ce n'est pas le cas, il ne pourra imprimer que 3105).

Explication

Cela imprime ces nombres indéfiniment, car l'auteur a dit qu'il était acceptable que le programme imprime des nombres supérieurs à 6 chiffres.

C'est beaucoup trop lent; vous pouvez utiliser ce programme (et le modifier 8300par n'importe quel N) pour démarrer l'impression à partir de nombres strictement supérieurs à N.

ℕ               Natural number: The Input is a natural number
 f              Factors: compute the factors of the Input
  {     }?      Call a predicate with the main Input as its output and the factors as Input
   k            Knife: remove the last factor(which is the Input itself)
    ∋           In: take one of those factors
     p.         Permute: the Output is a permutation of that factor
       !        Cut: ignore other possible permutations
         ?ẉ     Writeln: write the Input to STDOUT, followed by a line break
           ⊥    False: backtrack to try another value for the Input

Comme l'a souligné @ ais523, nous avons besoin d'une coupe pour éviter d'imprimer plusieurs fois si plusieurs de ses facteurs en sont des permutations.

Fatalize
la source
J'ai une réponse très similaire enregistrée comme brouillon. Malheureusement, je ne pense pas que cela fonctionne car il imprimera des numéros comme 857142 plus d'une fois, et l'auteur a dit que cela n'était pas autorisé. Je pense que le programme a besoin d'une coupe quelque part, ajoutant probablement trois caractères.
Ajout de 4 caractères en fait ... merci, j'ai oublié ça.
Fatalize
3

JavaScript (ES6), 10396 94 octets

Une fonction anonyme qui renvoie le tableau des entiers correspondants.

_=>[...Array(1e6).keys(F=i=>[...i+''].sort()+0)].filter(n=>n*(R=i=>F(n/i--)==F(n)||R(i)%i)(9))

Formaté et commenté

_ =>                                // main function, takes no input
  [...Array(1e6).keys(              // define an array of 1,000,000 entries
    F = i => [...i + ''].sort() + 0 // define F: function used to normalize a string by
  )]                                // sorting its characters
  .filter(n =>                      // for each entry in the array:
    n * (                           // force falsy result for n = 0
      R = i =>                      // define R: recursive function used to test if
        F(n / i--) == F(n) ||       // n/i is an anagram of n, with i in [1 … 9]
        R(i) % i                    // F(n/1) == F(n) is always true, which allows to stop
    )                               // the recursion; but we need '%i' to ignore this result
    (9)                             // start recursion with i = 9
  )                                 //

Statistiques de diviseur

Pour des nombres entiers à 6 chiffres, chaque rapport de 2à 9entre un nombre entier correspondant net son anagram est rencontré au moins une fois. Mais certains d'entre eux n'apparaissent que quelques fois:

 divisor | occurrences | first occurrence
---------+-------------+---------------------
    2    |    12       | 251748 / 2 = 125874
    3    |    118      | 3105   / 3 = 1035
    4    |    120      | 7128   / 4 = 1782
    5    |    4        | 714285 / 5 = 142857
    6    |    34       | 8316   / 6 = 1386
    7    |    49       | 9513   / 7 = 1359
    8    |    2        | 911736 / 8 = 113967
    9    |    23       | 9801   / 9 = 1089

Tester

Le test ci-dessous est limité à la plage [1 ... 39999]afin qu'il ne prenne pas trop de temps à terminer.

Arnauld
la source
Beaucoup plus rapide version, mais un peu plus: _=>[...Array(1e6).keys()].filter(n=>n&&![...Array(9)].every(_=>n%++i||(F=i=>[...i+''].sort()+'')(n/i)!=F(n),i=1)).
Neil
@Neil Votre suggestion m'a inspiré la version mise à jour qui est beaucoup plus rapide et 1 octet plus courte. Malheureusement, tous les diviseurs de 2à 9sont requis ( 8utilisés seulement deux fois pour 911736et 931176).
Arnauld
2

Perl 6 , 59 octets

{grep {grep .comb.Bag===*.comb.Bag,grep $_%%*,2..^$_}

Solution de force brute terriblement lente.

Il retourne une séquence paresseuse, donc je pourrais vérifier les premiers résultats, mais il n'atteindra pas tous les résultats dans un délai raisonnable. (Dois-je le marquer comme non concurrentiel?)

smls
la source
2

Pure Bash , 128 126 122 122 121 120 octets

for((;n<6**8;)){
c=0
for((j=++n;j;j/=10)){((c+=8**(j%10)));}
for k in ${a[c]};{((n%k))||{ echo $n;break;};}
a[c]+=\ $n
}

Essayez-le en ligne!

(Ce programme est relativement rapide - il n'a fallu que 14 minutes pour parcourir tous les numéros à 6 chiffres de mon MacBook. Malheureusement, TIO arrive à expiration car il impose une limite de durée d'exécution de 1 minute, ce qui ne suffit que pour passer au travers. les nombres à 5 chiffres ou plus.)

Utilitaires Bash + Unix, 117 octets

for n in {1..999999}
{
c=$(bc<<<0`sed 's/\(.\)/+8^\1/g'<<<$n`)
for k in ${a[c]};{((n%k))||echo $n;}
a[c]+=\ $n
}|uniq

C'est plus court que la version pure bash, mais un peu plus lent, probablement à cause de toutes les fourches.

Mitchell Spector
la source
1

05AB1E , 15 octets

[¼¾œJv¾Ñ¨Dyåi¾,

Explication:

[               # Start of infinite loop
 ¼              # Increase counter_variable by 1
  ¾œJv          # Loop through all the permutations of counter_variable
      ¾Ñ¨Dyå    # Check if a divisor of counter_variable is a permutation of counter_variable
            i¾, # If so, print counter_variable

Essayez-le en ligne! (cela ne fonctionnera pas, il expirera)

Okx
la source
0

Python 2, 98 octets

s=sorted;print filter(None,[[x for i in range(x)if s(`x`)==s(`i`)and x%i<1]for x in range(10**6)])
Trelzevir
la source
N'est-ce pas 10**6?
Neil
Oui merci.
Trelzevir
1
Je pense que ça x%i==0peut l'être x%i<1.
Yytsi
0

05AB1E , 12 10 octets

Expiration du délai sur TIO en raison d'une boucle infinie.
Enregistrement de 2 octets car nous pourrions produire plus de 6 chiffres selon le commentaire des OP.

[NѨ€{N{å–

Essayez-le en ligne!

Explication

[            # infinite loop with iteration index N
 NÑ          # get a list of all divisors of N
   ¨         # remove N from that list
    €{       # sort each entry in the list of divisors
      N{     # sort N
        å–   # output N if N is in the list
Emigna
la source
0

Lot, 263 octets

@echo off
set e=exit/b
for /l %%n in (1,1,999999)do call:n %%n
%e%
:n
call:c %1 1 0
for /l %%f in (2,1,9)do call:c %1 %%f %c%&&echo %1&&%e%
%e%
:c
set/ar=%1%%%2,d=%1/%2,c=-%3
if %r% gtr 0 %e%1
:l
set/ac+=1^<^<d%%10*3,d/=10
if %d% gtr 0 goto l
%e%%c%

Lent. Comme dans, prend plus d'une journée pour terminer sur mon PC. Explication: le csous - programme divise ses deux premiers arguments. Si le reste est nul, il calcule alors le hachage du résultat en calculant la somme des nièmes puissances de 8 pour chaque chiffre. Cette fonction de hachage, volée dans la réponse bash, n'entre en collision qu'avec des anagrammes. (Cela fonctionnerait pour les nombres à sept chiffres mais je n'ai pas tous les quinze jours.) Le troisième argument est soustrait et le sous-programme se termine avec un résultat véridique s'il est nul. Le nsous-programme appelle le csous - programme une fois pour calculer le hachage, puis huit fois de plus pour comparer le hachage; s'il trouve une collision, il imprime net quitte le sous-programme plus tôt.

Neil
la source