Czynniki anagramowe

19

W ostatnim odcinku QI pierwszych 5 mnożników 142857 opisano jako anagramy oryginalnej liczby. Oczywiście każdy, kto ma wiedzę na temat tej liczby, może wiedzieć, że liczby te są cykliczne, a nie tylko anagramy. Ale to mnie zastanowiło.

Napisz program lub funkcję, która wypisuje wszystkie liczby po sześć lub mniej cyfr, które mają odpowiedni współczynnik, który jest anagramem samego siebie. Lista powinna zaczynać się od następujących liczb:

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)

Jeśli wolisz, możesz znaleźć liczby z anagramem, który jest właściwym współczynnikiem liczby, ale pamiętaj, aby wykluczyć zera wiodące z anagramów.

To jest kod golfowy, więc wygrywa najkrótszy kod w bajtach, który nie łamie żadnych standardowych luk.

Neil
źródło
Jeśli otrzymamy wystarczająco dużo czasu, czy nasze programy mogą generować liczby zawierające więcej niż 6 cyfr?
Niebieski
1
Czy mógłbyś opublikować listę?
xnor
@muddyfish Tak, byłoby to do przyjęcia, pod warunkiem, że nie pomija żadnych liczb ani nie podaje niepoprawnych liczb.
Neil,
@ xnor Właściwie nie zawracałem sobie głowy obliczeniem całej listy, chociaż nie spodziewam się żadnych sporów.
Neil,
1
Zrobiłem pastebin z moich (mam nadzieję, że poprawnych) wyników.
Greg Martin

Odpowiedzi:

6

Mathematica (środowisko REPL), 75 74 bajtów

Dzięki ngenisis za zaostrzenie tego bajtu!

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

Sort/@IntegerDigits@Divisors@#tworzy posortowaną listę cyfr dla każdego dzielnika argumentu; sam numer wejściowy jest dzielnikiem, więc posortowana lista cyfr jest ostatnią. Most@#~MemberQ~Lastwykrywa, czy ta ostatnia posortowana lista cyfr pojawia się również na liście przed ostatnim elementem. I Select[Range[10!],...]zachowuje tylko te liczby całkowite do 3 628 800, które przejdą ten test (ta granica została wybrana, ponieważ jest o jeden bajt krótszy niż 10 6 ). Działa za około 5 minut na moim komputerze, uzyskując listę 494 liczb, z których największa to 3 427 191; istnieje 362 liczb do 10 6 , z których duża to 989,901.

Greg Martin
źródło
Cóż, nie jest to takie ciekawe: 857142 i 571428 to dwie liczby z dwiema oczywistymi właściwymi anagramami dzielnika.
Neil
W rzeczywistości 857142 ma trzy odpowiednie anagramy dzielników, prawda?
Neil
wygląda na to, że masz rację!
Greg Martin
Możesz zapisać bajt za pomocą IntegerDigits@Divisors@#.
ngenisis
3

Galaretka , 12 bajtów

ÆḌṢ€ċṢ
ȷ6ÇÐf

Wypróbuj online! (używa pięciu lub mniej cyfr ze względu na limit czasu TIO)

Weryfikacja

$ 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

Jak to działa

ȷ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
źródło
1
Z powodu tego komentarza możesz zrobić jeszcze wolniej ÆḌṢ€ċṢµȷ#przez 10. Zajęło ~ 27 minut, aby uruchomić na rdzeniu i7 (nie na Uniksie, nic przyjemnego time); największy wynik był 6671928.
Jonathan Allan
Zaczynam myśleć, że modyfikujesz Galaretkę na podstawie pytań 😏
Albert Renshaw
3

Brachylog , 12 bajtów

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

Wypróbuj online!

Może to jednak przekroczyć limit czasu przed wydrukowaniem czegokolwiek (a jeśli nie, wydrukuje tylko 3105).

Wyjaśnienie

Spowoduje to wydrukowanie tych liczb w nieskończoność, ponieważ autor stwierdził, że dopuszczalne jest, aby program wypisał liczby większe niż 6 cyfr.

To jest zbyt wolne; możesz użyć tego programu (i zmienić 8300przez dowolny N), aby rozpocząć drukowanie od liczb znacznie większych niż 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

Jak wskazał @ ais523, potrzebujemy cięcia, aby uniknąć wielokrotnego drukowania liczby, jeśli kilka jej czynników to permutacje.

Fatalizować
źródło
Mam bardzo podobną odpowiedź zapisaną jako szkic. Niestety nie sądzę, żeby to działało, ponieważ wypisze numery takie jak 857142 więcej niż jeden raz, a autor powiedział, że jest to niedozwolone. Myślę, że program potrzebuje gdzieś cięcia, prawdopodobnie dodającego trzy znaki.
Dodanie 4 znaków w rzeczywistości ... dzięki, zapomniałem o tym.
Fatalize
3

JavaScript (ES6), 10396 94 bajtów

Anonimowa funkcja zwracająca tablicę pasujących liczb całkowitych.

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

Sformatowane i skomentowane

_ =>                                // 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
  )                                 //

Statystyka dzielnika

W przypadku 6-cyfrowych liczb całkowitych każdy stosunek od 2do 9pasującej liczby całkowitej ni jej anagramu występuje co najmniej raz. Ale niektóre z nich pojawiają się tylko kilka razy:

 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

Test

Poniższy test jest ograniczony do zakresu, [1 ... 39999]więc jego ukończenie nie zajmuje dużo czasu.

Arnauld
źródło
Znacznie szybsza wersja, ale nieco dłużej: _=>[...Array(1e6).keys()].filter(n=>n&&![...Array(9)].every(_=>n%++i||(F=i=>[...i+''].sort()+'')(n/i)!=F(n),i=1)).
Neil
@ Nee Twoja sugestia zainspirowała mnie do zaktualizowanej wersji, która jest znacznie szybsza i 1 bajt krótsza. Niestety wszystkie dzielniki od 2do 9są wymagane ( 8używane tylko dwa razy dla 911736i 931176).
Arnauld
2

Perl 6 , 59 bajtów

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

Strasznie powolne rozwiązanie brutalnej siły.

Zwraca leniwą sekwencję, więc mogłem sprawdzić kilka pierwszych wyników, ale nie osiągnie wszystkich wyników w rozsądnym czasie. (Czy powinienem zaznaczyć to jako niekonkurujące?)

smls
źródło
2

Pure Bash , 128 126 122 121 120 bajtów

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
}

Wypróbuj online!

(Ten program jest dość szybki - przejście przez wszystkie 6-cyfrowe liczby na moim MacBooku zajęło tylko 14 minut. Niestety TIO przekroczyło limit czasu, ponieważ nakłada limit czasu 1 minuty, który jest wystarczający, aby przejść około 5-cyfrowe liczby.)

Narzędzia Bash + Unix, 117 bajtów

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

Jest to krótsze niż wersja czysto bashowa, ale nieco wolniejsze, prawdopodobnie w dużej mierze z powodu całego rozwidlania się.

Mitchell Spector
źródło
1

05AB1E , 15 bajtów

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

Wyjaśnienie:

[               # 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

Wypróbuj online! (to nie zadziała, upłynie limit czasu)

Okx
źródło
1

Japt , 23 bajty

L³o f_ì á ¤fg mì f!vZ l

Wypróbuj online! Zauważ, że połączony kod oblicza tylko 1e4, ponieważ 1e6 przekroczy limit czasu dla TIO.

Oliver
źródło
0

Python 2, 98 bajtów

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
źródło
Nie powinno tak być 10**6?
Neil,
Tak dziękuję.
Trelzevir,
1
Myślę, że x%i==0tak może być x%i<1.
Yytsi
0

05AB1E , 12 10 bajtów

Przekroczono limit czasu TIO z powodu nieskończonej pętli.
Zaoszczędziliśmy 2 bajty, ponieważ zgodnie z komentarzem OP możemy wydać więcej niż 6 cyfr.

[NѨ€{N{å–

Wypróbuj online!

Wyjaśnienie

[            # 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
źródło
0

Partia, 263 bajtów

@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%

Powolny. Jak w, zabiera dzień do końca na moim komputerze. Objaśnienie: cpodprogram dzieli pierwsze dwa argumenty. Jeśli reszta jest równa zero, wówczas oblicza skrót wyniku, obliczając sumę n-tych potęg 8 dla każdej cyfry. Ta funkcja skrótu, skradziona z odpowiedzi bash, zderza się tylko z anagramami. (To działałoby dla liczb siedmiocyfrowych, ale nie mam wszystkich co dwa tygodnie.) Trzeci argument jest odejmowany, a podprogram kończy się z prawdziwym wynikiem, jeśli wynosi zero. nPodprogram wywołuje cpodprogram raz do obliczania hash, a następnie osiem razy, aby porównać hash; jeśli znajdzie kolizję, drukuje ni opuszcza podprogram wcześniej.

Neil
źródło