Цепи Гозинты

(Вдохновлено проектом Эйлер # 606 )

Цепочка gozinta для n - это последовательность, в {1,a,b,...,n}которой каждый элемент правильно делит следующий. Например, существует восемь различных цепочек козинта на 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}.

Соревнование

Напишите программу или функцию, которая принимает положительное целое число ( n > 1) и выводит или возвращает все различные цепочки козинты для данного числа.

1. Порядок в цепях имеет значение (по возрастанию), порядок цепочек не имеет.
2. На случай, если он существует, вы не можете использовать встроенную функцию, которая решает проблему.
3. Это код-гольф .

Редактировать: удаление 1в качестве потенциального ввода.

Python 3 , 68 65 байт

Редактировать: -3 байта благодаря @notjagan

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

Попробуйте онлайн!

объяснение

Каждая цепочка козинты состоит из числа xв конце цепочки, по крайней мере с одним делителем слева от нее. Для каждого делителя kиз xцепей [1,...,k,x]различны. Таким образом , мы можем для каждого делителя kнайти все его различные gozinta цепей и присоединять xк концу них, чтобы получить всю различную gozinta цепь с kнепосредственно слева x. Это делается рекурсивно до тех пор , x = 1когда [[1]]не возвращается, так как все gozinta цепь начинается с 1, то есть рекурсией нижнего предела.

Код становится таким коротким из-за понимания списка Python, допускающего двойную итерацию. Это означает, что найденные значения f(k)могут быть добавлены в один и тот же список для всех различных делителей k.

Шелуха , 13 байт

ufo=ḣ⁰…ġ¦ΣṖḣ⁰

Несколько иной подход к H.PWiz , хотя все еще грубой силой. Попробуйте онлайн!

объяснение

Основная идея состоит в том, чтобы объединить все подпоследовательности [1,...,n]и разбить результат на подсписки, где каждый элемент делит следующий. Из них мы оставляем те, которые начинаются с 1, заканчиваются nи не содержат дубликатов. Это делается с помощью встроенной функции rangify …. Затем остается отказаться от дубликатов.

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.

Желе , 9 8 байт

ÆḌ߀Ẏ;€ȯ

Попробуйте онлайн!

Использует технику, аналогичную моему ответу Japt , и поэтому очень быстро работает на больших тестовых примерах .

Как это работает

ÆḌ߀Ẏ;€ȯ    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 байт

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

Формирует a, Graphгде вершины являются Divisorsвходными данными #, а ребра представляют правильную делимость, а затем находят Allпути от вершины 1к вершине #.

Желе , 12 байт

ŒPµḍ2\×ISµÐṀ

Монадическая ссылка, принимающая целое число и возвращающая список списков целых чисел.

Попробуйте онлайн!

Как?

Мы хотим, чтобы все отсортированные списки уникальных целых чисел от одного до N были такими, что первый - это один, последний - это N, и все пары делятся. Код достигает этого фильтра, проверяя, что критерии парного деления удовлетворяются по набору мощности рассматриваемого диапазона, но выбираются только те, у которых максимальные суммы приращенной разности (те, которые начинаются с одного и заканчиваются на N, будут иметь сумма инкрементных разностей N-1, у других будет меньше).

Œ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 байт

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

Проверьте это онлайн!

Как ни странно, генерация вывода в виде строки была намного проще, чем генерация в виде массива массивов ...

объяснение

 ⬠£  ß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 байт

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

Использование недокументированных мульти-Arg формы Divisible, где Divisible[n1,n2,...]возвращается , Trueесли n2∣n1, n3∣n2и так далее, и в Falseпротивном случае. Мы принимаем все Subsetsиз списка Divisorsвходных данных #, а затем вернуть Casesформы {1,___,#}таким образом, что Divisibleдает Trueдля Reverseд последовательности делителей.

Haskell, 51 байт

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

Рекурсивно находи козинты цепочки правильных делителей и добавляй n.

Попробуйте онлайн!

Haskell (Lambdabot), 92 85 байт

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)

Требуется Lambdabot Haskell, так как guardтребует Control.Monadимпорта. Основная функция - это анонимная функция, которая, как мне сказали, разрешена и сбрасывает пару байтов.

Спасибо Лайкони за сохранение семи байтов.

Объяснение:

Монады очень удобны.

x # y

Это наша рекурсивная функция, которая выполняет всю реальную работу. xэто число, которое мы накапливаем (произведение делителей, которые остаются в значении), и yследующее число, которое мы должны попытаться разделить на него.

 | x == y = [[x]]

Если xравно, yто мы закончили повторение. Просто используйте xв качестве конца текущей цепочки gozinta и вернуть его.

 | 1 > 0 =

Haskell golf-ism для "True". То есть это случай по умолчанию.

(guard (mod x y < 1) >>

Сейчас мы работаем внутри монады списка. В монаде списка у нас есть возможность сделать несколько вариантов одновременно. Это очень полезно при поиске «всего возможного» чего-либо путем истощения. В guardзаявлении говорится: «Рассматривайте следующий выбор только в том случае, если условие истинно». В этом случае рассмотрите только следующий выбор, если yделит x.

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

Если yесть деление x, у нас есть выбор добавления yв цепочку gozinta. В этом случае рекурсивно вызывайте (#), начиная y = 2с xравным x / y, так как мы хотим «вычеркнуть» то, что yмы только что добавили в цепочку. Затем, каким бы ни был результат этого рекурсивного вызова, умножьте его значения на значения, которые yмы только yчто проанализировали, и официально добавьте в цепочку gozinta.

++

Рассмотрим также следующий выбор. Это просто складывает два списка вместе, но монадически мы можем думать об этом, как о «выборе между выполнением этой вещи ИЛИ этой другой вещью».

x # (y + 1)

Другой вариант - просто продолжить рекурсию и не использовать значение y. Если yне делится, xто это единственный вариант. Если yделится, xто будет выбран этот вариант, а также другой вариант, и результаты будут объединены.

map (1 :) . (# 2)

Это основная функция gozinta. Он начинает рекурсию с вызова (#)аргумента. A 1добавляется к каждой цепочке gozinta, потому что (#)функция никогда не помещает их в цепочки.

Хаскелл, 107 100 95 байт

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]

Может быть, есть лучшее условие завершения (пробовал что-то вроде

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

но это дольше). Проверка 1кажется благоразумной, как очистка повторов 1или дубликатов (nub не вPrelude ) больше байтов.

Попробуйте онлайн.

JavaScript (Firefox 30-57), 73 байта

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

Удобно n%0<1это ложь.

Желе , 17 байт

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

Попробуйте онлайн!

Mathematica, 104 байта

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

Mathematica, 72 байта

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

объяснение

Divisors@#

Найти все делители ввода.

Subsets@ ...

Создайте все подмножества этого списка.

Cases[ ... ]

Выберите все случаи, которые соответствуют шаблону ...

{1,___,#}

Начиная с 1 и заканчивая <input>...

?( ... )

и удовлетворяет условию ...

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

Левый элемент делит правый элемент на все 2 раздела списка, смещение 1.

TI-BASIC, 76 байт

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

объяснение

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.

Я мог бы сохранить еще 5 байтов, если разрешено завершать с ошибкой, а не изящно, удалив проверку Ans> 1 и условие цикла. Но я не уверен, что это разрешено.

Mathematica 86 77 байт

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

Грубая сила по определению.

Желая был более короткий способ сделать попарно последовательное сравнение элементов списка.

Спасибо @Jenny_mathy и @JungHwanMin за предложения по экономии 9 байт

Шелуха , 17 16 байт

-1 байт, спасибо Zgarb

foEẊ¦m`Je1⁰Ṗthḣ⁰

Попробуйте онлайн!

PHP 147 141

Отредактировано для удаления лишнего теста

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

Разъяснение:

function g($i) {

15 символов шаблона :(

    $r = [[1]];

Инициируйте набор результатов, [[1]]поскольку каждая цепочка начинается с 1. Это также приводит к поддержке 1 в качестве входа.

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

Для каждого числа от 2 до $i, мы собираемся расширить каждую цепочку в нашем наборе на текущее число, если оно идет , а затем добавить расширенную цепочку в наш набор результатов.

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

Отфильтруйте наши промежуточные цепочки, которые не дошли до $i

    return $R;
}

10 символов шаблона :(

Mathematica

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

Ответ кешируется для дополнительных звонков.