Łańcuchy Gozinta

(Zainspirowany projektem Euler # 606 )

Łańcuch gozinty dla n jest sekwencją, w {1,a,b,...,n}której każdy element prawidłowo dzieli następny. Na przykład istnieje osiem różnych łańcuchów gozinty dla 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}.

Wyzwanie

Napisz program lub funkcję, która akceptuje dodatnią liczbę całkowitą ( n > 1) i wyświetla lub zwraca wszystkie odrębne łańcuchy gozinta dla podanej liczby.

1. Porządek w łańcuchach ma znaczenie (rosnąco), porządek łańcuchów nie.
2. Jeśli istnieje taka szansa, nie możesz użyć wbudowanego rozwiązania, które rozwiązuje wyzwanie.
3. To jest golf golfowy .

Edycja: usuwanie 1jako potencjalny wkład.

Python 3 , 68 65 bajtów

Edycja: -3 bajty dzięki @notjagan

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

Wypróbuj online!

Wyjaśnienie

Każdy łańcuch gozinty składa się z liczby xna końcu łańcucha, z przynajmniej jednym dzielnikiem po jego lewej stronie. Dla każdego dzielnik ko xłańcuchach [1,...,k,x]są różne. Możemy zatem dla każdego dzielnika kznaleźć wszystkie swoje odrębne łańcuchy gozinta i dołączania xdo końca z nich, aby uzyskać wszystkie odrębne łańcuchy gozinta z kbezpośrednio z lewej strony x. Odbywa się to rekursywnie aż x = 1gdzie [[1]]zostanie zwrócony, ponieważ wszystkie łańcuchy gozinta rozpocząć 1, co oznacza, że rekurencja mają najniższy.

Kod staje się tak krótki dzięki zrozumieniu listy w Pythonie, umożliwiając podwójną iterację. Oznacza to, że wartości znalezione w f(k)można dodać do tej samej listy dla wszystkich różnych dzielników k.

Łuska , 13 bajtów

ufo=ḣ⁰…ġ¦ΣṖḣ⁰

Nieco inne podejście do H.PWiza , choć wciąż brutalne. Wypróbuj online!

Wyjaśnienie

Podstawową ideą jest połączenie wszystkich podsekwencji [1,...,n]i podzielenie wyniku na listy podrzędne, w których każdy element dzieli następny. Spośród nich przechowujemy te, które zaczynają się 1, kończą ni nie zawierają duplikatów. Odbywa się to za pomocą wbudowanego „rangify” …. Następnie pozostaje odrzucić duplikaty.

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.

Galaretka , 9 8 bajtów

ÆḌ߀Ẏ;€ȯ

Wypróbuj online!

Używa techniki podobnej do mojej odpowiedzi Japt , a zatem działa bardzo szybko na większych przypadkach testowych.

Jak to działa

ÆḌ߀Ẏ;€ȯ    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 bajtów

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

Tworzy miejsce, w Graphktórym wierzchołki należą do Divisorsdanych wejściowych #, a krawędzie reprezentują odpowiednią podzielność, a następnie znajduje Allścieżki od wierzchołka 1do wierzchołka #.

Galaretka , 12 bajtów

ŒPµḍ2\×ISµÐṀ

Monadyczny link akceptujący liczbę całkowitą i zwracający listę list liczb całkowitych.

Wypróbuj online!

W jaki sposób?

Chcemy, aby wszystkie posortowane listy unikatowych liczb całkowitych między jednym a N były takie, że pierwsza to jedna, ostatnia to N, a wszystkie pary dzielą się. Kod osiąga ten filtr, sprawdzając, czy kryteria podziału parami są spełnione w porównaniu z zestawem mocy danego zakresu, ale tylko wybierając te z maksymalnymi sumami różnic przyrostowych (te, które zaczynają się od jednego, a kończą na N, będą miały suma różnic przyrostowych N-1, inne będą miały mniej).

Œ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 bajtów

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

Przetestuj online!

Co dziwne, wygenerowanie wyniku w postaci ciągu było o wiele łatwiejsze niż wygenerowanie go jako tablicy tablic ...

Wyjaśnienie

 ⬠£  ß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 bajtów

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

Korzysta z nieudokumentowanej formy wielu argumentów Divisible, gdzie Divisible[n1,n2,...]zwraca Truejeśli n2∣n1, n3∣n2itd False. Itd. Bierzemy wszystko Subsetsz listy Divisorswejścia #, a potem wróć do Casesformy {1,___,#}takiej, która Divisibledaje Trueo Reversesekwencji D dzielników.

Haskell, 51 bajtów

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

Rekurencyjnie znajdź łańcuchy właściwych dzielników gozinta i dołącz n.

Wypróbuj online!

Haskell (Lambdabot), 92 85 bajtów

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)

Potrzebuje Lambdabot Haskell, ponieważ guardwymaga Control.Monadimportu. Główna funkcja jest funkcją anonimową, o której, jak mi powiedziano, jest dozwolona i goli kilka bajtów.

Dzięki Laikoni za zaoszczędzenie siedmiu bajtów.

Wyjaśnienie:

Monady są bardzo przydatne.

x # y

To jest nasza funkcja rekurencyjna, która wykonuje całą rzeczywistą pracę. xto liczba, nad którą się kumulujemy (iloczyn dzielników, które pozostają w wartości) i yjest następną liczbą, którą powinniśmy spróbować podzielić.

 | x == y = [[x]]

Jeśli xjest równy y, to zakończyliśmy rekurencję. Wystarczy użyć xjako końca bieżącego łańcucha gozinta i zwrócić go.

 | 1 > 0 =

Haskell golf-ism dla „True”. To jest przypadek domyślny.

(guard (mod x y < 1) >>

Działamy teraz na liście monad. W ramach monady listy mamy możliwość dokonywania wielu wyborów jednocześnie. Jest to bardzo pomocne przy znajdowaniu „wszystkiego, co możliwe” czegoś przez wyczerpanie. W guardoświadczeniu jest napisane: „rozważ następujący wybór tylko wtedy, gdy spełniony jest warunek”. W takim przypadku rozważ tylko następujący wybór, jeśli ydzieli x.

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

Jeśli y dzieli x, mamy do wyboru dodanie ydo łańcucha gozinta. W tym przypadku, rekurencyjnie zadzwonić (#), wychodząc na co y = 2się xrówna x / y, ponieważ chcemy „czynnik out”, które ypo prostu dodaje się do łańcucha. Następnie, bez względu na wynik tego rekurencyjnego wezwania, pomnóż jego wartości przez ywłaśnie uwzględnione i yoficjalnie dodaj do łańcucha gozinta.

++

Rozważ również następujący wybór. To po prostu dodaje obie listy razem, ale monadycznie możemy myśleć o tym jako o powiedzeniu „wybierz między robieniem tego, a tym innym”.

x # (y + 1)

Inną opcją jest po prostu kontynuowanie rekurencji i nie używanie wartości y. Jeśli ynie dzieli, xjest to jedyna opcja. Jeśli ydzieli, xto ta opcja zostanie wzięta, podobnie jak druga opcja, a wyniki zostaną połączone.

map (1 :) . (# 2)

Jest to główna funkcja gozinta. Rozpoczyna rekursję od wywołania(#) z argumentem. A 1jest dołączane do każdego łańcucha gozinta, ponieważ (#)funkcja nigdy nie umieszcza jednych w łańcuchach.

Haskell, 107 100 95 bajtów

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]

Może jest lepszy warunek zakończenia (próbował czegoś takiego

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

ale jest dłuższy). Kontrola 1wydaje się być ostrożna, ponieważ powtarzanie szorowania 1lub duplikaty (nub nie w Prelude) to więcej bajtów.

Wypróbuj online.

JavaScript (Firefox 30-57), 73 bajty

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

Dogodnie n%0<1jest to fałsz.

Galaretka , 17 bajtów

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

Wypróbuj online!

Mathematica, 104 bajty

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

Mathematica, 72 bajty

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

Wyjaśnienie

Divisors@#

Znajdź wszystkie dzielniki wejścia.

Subsets@ ...

Wygeneruj wszystkie podzbiory z tej listy.

Cases[ ... ]

Wybierz wszystkie etui, które pasują do wzoru ...

{1,___,#}

Począwszy od 1, a kończąc na <input>...

?( ... )

i spełnia warunek ...

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

Lewy element dzieli prawy element dla wszystkich 2-partycji listy, przesunięcie 1.

TI-BASIC, 76 bajtów

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

Wyjaśnienie

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.

Mógłbym zapisać kolejne 5 bajtów, jeśli można wyjść z błędem zamiast z wdziękiem, usuwając zaznaczenie Ans> 1 i warunek pętli. Ale nie jestem pewien, czy to dozwolone.

Mathematica 86 77 bajtów

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

Brutalna siła z definicji.

Żałując, że nie istnieje krótszy sposób na porównanie parami elementów sekwencyjnych listy.

Dzięki @Jenny_mathy i @JungHwanMin za sugestie oszczędzające 9 bajtów

Łuska , 17 16 bajtów

-1 bajt, dzięki Zgarb

foEẊ¦m`Je1⁰Ṗthḣ⁰

Wypróbuj online!

PHP 147 141

Edytowano, aby usunąć zbędny 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;}

Wyjaśnił:

function g($i) {

15 znaków płyty kotłowej :(

    $r = [[1]];

Zainicjuj wynik ustawiony na [[1]] tak, jak każdy łańcuch zaczyna się od 1. To również prowadzi do obsługi 1 jako danych wejściowych.

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

Dla każdej liczby od 2 do $iprzedłużymy każdy łańcuch w naszym zestawie o bieżącą liczbę, jeśli będzie to gozinta , a następnie dodamy rozszerzony łańcuch do naszego zestawu wyników.

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

Odfiltruj nasze łańcuchy pośrednie, które tego nie zrobiły $i

    return $R;
}

10 znaków płyty kotłowej :(

Matematyka

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

Odpowiedź jest zapisywana w pamięci podręcznej dla dodatkowych połączeń.