Фрактальная последовательность дыма

33

Введение

У A229037 довольно интригующий сюжет (по крайней мере, для первых нескольких терминов):

Существует предположение, что у него действительно может быть какое-то фрактальное свойство.

Как строится эта последовательность?

Определить a(1) = 1, a(2) = 1то для каждого n>2найти минимальное положительное целое число , a(n)такое , что для каждого арифметического 3 члена последовательности n,n+k,n+2kиндексов, соответствующие значения последовательности a(n),a(n+k),a(n+2k)является не арифметической последовательности.

Вызов

Если nв качестве входных данных положительное целое число , выведите первые nчлены a(1), ... , a(n)этой последовательности. (С любым разумным форматированием. Возможные начальные / обучающие символы / строки не имеют значения.)

Существуют фрагменты для генерации этой последовательности, но я думаю, что другие подходы могут быть более подходящими для игры в гольф / более подходящими для определенных языков.

Пожалуйста, дайте нам знать, как работает ваша программа. Если вы столкнетесь с особенно эффективным алгоритмом, вы также можете упомянуть об этом, так как он позволит построить больше членов последовательности за более короткое время.

Первые несколько тестов:

1, 1, 2, 1, 1, 2, 2, 4, 4, 1, 1, 2, 1, 1, 2, 2, 4, 4, 2, 4, 4, 5, 5, 8, 5, 5, 9, 1, 1, 2, 1, 1, 2, 2, 4, 4, 1, 1, 2, 1, 1, 2, 2, 4, 4, 2, 4, 4, 5, 5, 8, 5, 5, 9, 9, 4, 4, 5, 5, 10, 5, 5, 10, 2, 10, 13, 11, 10, 8, 11, 13, 10, 12, 10, 10, 12, 10, 11, 14, 20, 13

Больше тестов:

  a(100)  =   4
  a(500)  =   5
 a(1000)  =  55
 a(5000)  =  15
a(10000)  = 585

Все условия до n=100000доступны здесь: https://oeis.org/A229037/b229037.txt

Спасибо @ MartinBüttner за помощь и поддержку.

flawr
источник
2
Эй, где я видел этот график раньше? :-D
Луис Мендо
12
Сдвиньте голову немного влево, увеличьте немного, и все! (:
flawr
4
Только что появилось видеофайл: youtube.com/watch?v=o8c4uYnnNnc
flawr
2
Могу поспорить, что его код не такой уж гольфовый!
Луис Мендо

Ответы:

12

Python 2, 95 байт

l=[];n=input()
exec"a=min(set(range(n))-{2*b-c for b,c in zip(l,l[1::2])});print-~a;l=[a]+l;"*n

Основная хитрость заключается в генерации чисел, которых должно избегать новое значение. Сохранение обратной последовательности до сих пор вl , давайте посмотрим, какие элементы могут формировать трехчленную арифметическую прогрессию со значением, которое мы собираемся добавить.

? 4 2 2 1 1 2 1 1   a b c
^ ^ ^               ? 4 2
^   ^   ^           ? 2 1
^     ^     ^       ? 2 2
^       ^       ^   ? 1 1

Другие числа являются парными членами lи каждым вторым элементом l, поэтому zip(l,l[1::2]). Если эта пара, (b,c)то арифметическая прогрессия (a,b,c)происходит для a=2*b-c. После генерации набора aсимволов, чтобы избежать, код берет минимум дополнения, печатает его и добавляет его в список. (На самом деле, вычисления выполняются с числами, уменьшенными на 1, и напечатанными на 1 выше, чтобы можно было range(n)служить универсумом кандидатов.)

XNOR
источник
8

Mathematica, 95 байт

For[n_~s~k_=0;n=0,n<#,For[i=n,--i>0,s[2n-i,2f@n-f@i]=1];For[++n;i=1,n~s~i>0,++i];Print[f@n=i]]&

Конечно, это не самый удачный подход, но на самом деле он довольно эффективен по сравнению с алгоритмами, которые я попробовал со страницы OEIS.

В отличие от проверки всех запрещенных значений для каждого s (n), когда мы доберемся туда, я использую основанный на сите подход. Когда мы находим новое значение s (n), мы немедленно проверяем, какие значения это запрещает для m> n . Тогда мы просто решаем s (n + 1) , ища первое значение, которое не было запрещено.

Это можно сделать еще более эффективным, изменив условное --i>0на 2n-#<=--i>0. В этом случае мы избегаем проверки запрещенных значений для n больше, чем ввод.

Для более удобочитаемой версии я начал с этого кода, в котором результаты сохраняются maxв одной функции f, а затем применил его к указанной выше однострочной чистой функции:

 max = 1000;
 ClearAll[sieve, f];
 sieve[n_, k_] = False;
 For[n = 0, n < max,
  temp = f[n];
  For[i = n - 1, i > 0 && 2 n - i <= max, --i,
   sieve[2 n - i, 2 temp - f[i]] = True;
   ];
  ++n;
  i = 1;
  While[sieve[n, i], ++i];
  f@n = i;
  ]
Мартин Эндер
источник
3

Haskell, 90 , 89 , 84 , 83 байта

Вероятно, можно играть в гольф больше, но это все еще достойная первая попытка:

a n|n<1=0|n<3=1|1<2=[x|x<-[1..],and[x/=2*a(n-k)-a(n-k-k)||a(n-k-k)<1|k<-[1..n]]]!!0

Ungolfed:

a n | n<1        = 0 
    | n<3        = 1
    | otherwise  = head (goods n)

goods n = [x | x <- [1..], isGood x n]

isGood x n = and [ x - a(n-k) /= a(n-k) - a(n-k-k) || a(n-k-k) == 0 | k <- [1..n] ]

Это простая реализация, которая возвращает '0' за пределами. Затем для каждого возможного значения он проверяет, что для всех k <= n и в пределах [x, a (xk), a (x-2k)] не является арифметической последовательностью.

Верхняя граница сложности времени (используя факт из страницы OEIS, что a (n) <= (n + 1) / 2:

t n <= sum[ sum[2*t(n-k) + 2*t(n-k-k) | k <- [1..n]] | x <- [1..(n+1)/2]]
    <= sum[ sum[4*t(n-1)              | k <- [1..n]] | x <- [1..(n+1)/2]]
    <= sum[     4*t(n-1)*n                         ] | x <- [1..(n+1)/2]]
    <=          4*t(n-1)*n*(n+1)/2
    ->
O(t(n)) == O(2^(n-2) * n! * (n+1)!)

Я не уверен, насколько хороша эта граница, потому что вычисление первых 1k значений 't' и использование линейной модели на логах значений дало appx. O (22 ^ n), с p-значением <10 ^ (- 1291), если это имеет значение.

На уровне реализации, компилируясь с '-O2', потребовалось ~ 35 минут, чтобы вычислить первые 20 значений.

Майкл Кляйн
источник
1
Какова сложность времени для вашей программы?
flawr
@flawr Добавил некоторый анализ сложности времени к сообщению
Майкл Кляйн
3

Брахилог , 33 31 байт

;Ė{~b.hℕ₁≜∧.¬{ġh₃hᵐs₂ᶠ-ᵐ=}∧}ⁱ⁽↔

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

В случае, если это имеет значение: 2-байтовый гольф стал возможен благодаря функции, которую я запросил после работы над этой задачей.

объяснение

Мы итеративно генерируем последовательность в виде списка в обратном порядке, например [2,2,1,1,2,1,1] , и переворачиваем ее в конце.

Здесь есть несколько вложенных предикатов. Давайте посмотрим на них изнутри. Первый из них, ġh₃hᵐs₂ᶠ-ᵐ=принимает подпоследовательность кандидата a(n),a(n-1),...,a(0)и определяет, a(n),a(n-k),a(n-2k)является ли арифметическая последовательность для некоторых k.

ġ            Group the list into equal-length sublists (with the possible exception of
             the last sublist, which might be shorter)
 h₃          Get the first 3 sublists from that list
   hᵐ        and get the head of each of those 3 sublists
             We now have a list containing a(n),a(n-k),a(n-2k) for some k
     s₂ᶠ     Find all 2-element sublists of that list: [a(n),a(n-k)] and [a(n-k),a(n-2k)]
        -ᵐ   Find the difference of each pair
          =  Assert that the two pairwise differences are equal

Например, с вводом [1,2,1,1,2,1,1]:

ġ has possible outputs of
    [[1],[2],[1],[1],[2],[1],[1]]
    [[1,2],[1,1],[2,1],[1]]
    [[1,2,1],[1,2,1],[1]]
    [[1,2,1,1],[2,1,1]]
    [[1,2,1,1,2],[1,1]]
    [[1,2,1,1,2,1],[1]]
    [[1,2,1,1,2,1,1]]
h₃ has possible outputs of
    [[1],[2],[1]]
    [[1,2],[1,1],[2,1]]
    [[1,2,1],[1,2,1],[1]]
hᵐ has possible outputs of
    [1,2,1]
    [1,1,2]
    [1,1,1]
s₂ᶠ has possible outputs of
    [[1,2],[2,1]]
    [[1,1],[1,2]]
    [[1,1],[1,1]]
-ᵐ has possible outputs of
    [-1,1]
    [0,-1]
    [0,0]
= is satisfied by the last of these, so the predicate succeeds.

Следующий предикат наружу ~b.hℕ₁≜∧.¬{...}∧вводит подпоследовательность a(n-1),a(n-2),...,a(0)и выводит следующую большую подпоследовательность a(n),a(n-1),a(n-2),...,a(0).

~b.hℕ₁≜∧.¬{...}∧
~b.                 The input is the result of beheading the output; i.e., the output is
                    the input with some value prepended
  .h                The head of the output
    ℕ₁              is a natural number >= 1
      ≜             Force a choice as to which number (I'm not sure why this is necessary,
                    but the code doesn't work without it)
        ∧           Also,
         .          the output
          ¬{...}    does not satisfy the nested predicate (see above)
                    I.e. there is no k such that a(n),a(n-k),a(n-2k) is an arithmetic sequence
                ∧   Break unification with the output

Наконец, основной предикат ;Ė{...}ⁱ⁽↔принимает входное число и выводит столько членов последовательности.

;Ė{...}ⁱ⁽↔
;           Pair the input number with
 Ė          the empty list
  {...}ⁱ⁽   Using the first element of the pair as the iteration count and the second
            element as the initial value, iterate the nested predicate (see above)
         ↔  Reverse, putting the sequence in the proper order
DLosc
источник
3

Рубин , 71 байт

->n,*a{a.fill(0,n){|s|([*1..n]-(1..s/2).map{|o|2*a[s-o]-a[s-2*o]})[0]}}

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

Создает все запрещенные значения, затем принимает дополнение этого массива в (1..n) и принимает первое значение результата. Это означает, что я предполагаю, чтоa[n] <= n для всех n, что легко доказать с помощью индукции (если все первые n / 2 слагаемых меньше n / 2, то не может быть арифметической прогрессии, приводящей к n).

Синтаксический трюк здесь также немного интересен: *aон используется для инициализации массива дополнительных аргументов (который был бы проигнорирован, если бы мы его передали), а затем a.fillизменяет массив аргументов и неявно возвращает его.

histocrat
источник
1
-1 байт: вместо a[s-o]и a[s-2*o], вы можете использовать a[s-=1]иa[s-o]
GB
3

APL (Dyalog Extended) , 37 байт SBCS

Большое спасибо Адаму за его помощь в написании и игре в гольф этот ответ в саду APL , отличном месте для изучения языка APL. Попробуйте онлайн!

Редактировать: -6 байт благодаря Адаму

⌽{⍵,⍨⊃(⍳1+≢⍵)~-¯2⊥⍵[2×⍀⍥⍳⌊2÷⍨≢⍵]}⍣⎕,⍬

объяснение

{⍵,⍨⊃(⍳1+≢⍵)~-¯2⊥⍵[2×⍀⍥⍳⌊2÷⍨≢⍵]}   is our right argument, the sequence S

                        2÷⍨≢⍵    We start by calculating X = len(S2
                                 Get a range [1, X]
                   2×⍀⍥           With that we can get S[:X] and S[:X×2:2]
                                  or S up to halfway and every 2nd element of S
             2⊥⍵[           ]   And with that we can get 2*S[:X] - S[:X×2:2]
                                  Which is C=2*B-A of a progression A B C
     (⍳1+≢⍵)~                     We remove these Cs from our possible a(n)s
                                  I use range [1, len(S)+1]
                                 Get the first result, which is the minimum
 ⍵,⍨                              And then prepend that to S


⌽{...}⍣⎕,⍬

 {...}⍣⎕    We iterate an "input"  times
        ,⍬  with an empty list  as the initial S
           and reversing S at the end as we have built it backwards

APL (Dyalog Unicode) , 43 39 38 байт SBCS

Вот более быстрое, но менее гольфовое решение, которое может рассчитать ⍺(10000) за несколько секунд.

⌽{⍵,⍨⊃(⍳1+≢⍵)~-⌿⍵[1 2 1∘.×⍳⌊2÷⍨≢⍵]}⍣⎕,⍬

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

Sherlock9
источник
2

МАТЛАБ, 156 147 байт

Наконец-то я немного поиграл в гольф:

N=input('');s=[0;0];for n=1:N,x=s(n,~~s(n,:));try,a(n)=find(~ismember(1:max(x)+1,x),1);catch,a(n)=1;end,s(n+1:2*n-1,end+1)=2*a(n)-a(n-1:-1:1);end,a

Ungolfed:

N=input('');                                   % read N from stdin

s=[0;0];
for n=1:N,
    x=s(n,~~s(n,:));                           % x=nonzeros(s(n,:));
    try,
        a(n)=find(~ismember(1:max(x)+1,x),1);  % smallest OK number
    catch,
        a(n)=1;                                % case of blank page for n
    end,

    s(n+1:2*n-1,end+1)=2*a(n)-a(n-1:-1:1);     % determined new forbidden values
end,
a                                              % print ans=...

Ввод считывается из STDIN, и печать выполняется автоматически с ans= добавлением материала. Я надеюсь, что это квалифицируется как «разумный» вывод.

Это также сита на основе раствора: переменная s(i,:)отслеживает тех значений последовательности , которые запрещены для a(i). try-catchБлок необходим для лечения случая пустых ( что означает полный ноль)s матрицы: в этом случае наименьшее значение1 уже разрешено.

Тем не менее, потребность в памяти (или время выполнения?) Становится довольно грязной выше N=2000. Итак, вот неконкурентное, более эффективное решение:

%pre-alloc
s = zeros([N,fix(N*0.07+20)]); %strict upper bound, needs adjusting later
i = zeros(1,N);

a = 1;
for n = 2:N,
    x = s(n,1:i(n));
    if isempty(x),
        a(n) = 1;
    else
        a(n) = find(~ismember(1:max(x)+1,x),1);
    end,

    j = n+1:min(2*n-1,N);
    i(j) = i(j)+1;
    s(N,max(i(j))) = 0;   %adjust matrix size if necessary
    b = a(n-1:-1:1);
    s(sub2ind([N,size(s,2)+1],j,i(j))) = 2*a(n)-b(1:length(j));
end

В этой реализации sматрица снова содержит запрещенные значения, но в упорядоченном виде, без каких-либо нулевых блоков (которые присутствуют в конкурирующей версии). Индексный вектор iотслеживает количество запрещенных векторов в s. С первого взгляда было бы здорово следить за информацией, хранящейся вs , но она была бы медленной, и мы не могли индексировать кучу их одновременно.

Одна из неприятных особенностей MATLAB заключается в том, что, хотя вы можете сказать M(1,end+1)=3;и автоматически развернуть матрицу, вы не можете сделать то же самое с линейным индексированием. Это имеет смысл (как MATLAB знать размер результирующего массива, в рамках которого он должен интерпретировать линейные индексы?), Но это все равно меня удивило. Это причина лишней линии s(N,max(i(j))) = 0;: это расширит sматрицу для нас всякий раз, когда это необходимо. Начальный размер угадатьN*0.07+20Кстати, зависит от линейного соответствия первых нескольких элементов.

Чтобы проверить время выполнения, я также проверил слегка измененную версию кода, где я инициализировал sматрицу, чтобы иметь размер N/2. Для первых 1e5элементов это, кажется, очень щедрое предположение, поэтому я удалил шаг расширения, sупомянутый в предыдущем абзаце. Все вместе они означают, что код будет быстрее, но также и менее устойчивым на очень высоком уровне N(поскольку я не знаю, как там выглядит серия).

Итак, вот несколько времени выполнения, сравнивая

  • v1: конкурирующая версия для гольфа,
  • v2: версия с низким начальным размером, надежная версия и
  • v3: щедрая версия начального размера, возможный сбой для большого N

Я измерил их на R2012b, взяв лучший из 5 прогонов в определении именованной функции с помощью tic/toc.

  1. N=100:
    • v1: 0.011342 s
    • v2: 0.015218 s
    • v3: 0.015076 s
  2. N=500:
    • v1: 0.101647 s
    • v2: 0.085277 s
    • v3: 0.081606 s
  3. N=1000:
    • v1: 0.641910 s
    • v2: 0.187911 s
    • v3: 0.183565 s
  4. N=2000:
    • v1: 5.010327 s
    • v2: 0.452892 s
    • v3: 0.430547 s
  5. N=5000:
    • v1: N / A (не ждал)
    • v2: 2.021213 s
    • v3: 1.572958 s
  6. N=10000:
    • Версия 1: N / A
    • v2: 6.248483 s
    • v3: 5.812838 s

Казалось бы, v3версия значительно, но не намного быстрее. Я не знаю, стоит ли элемент неопределенности (для очень большого N) незначительного увеличения времени выполнения.

Андрас Дик
источник
M=1;M(end+1)=2;у меня прекрасно работает?
flawr
@flawr, который будет работать для скаляров и векторов. Попробуйте M=rand(2); M(end+1)=2вместо этого :)
Андрас Дик
Ах, теперь я вижу =)
flawr
2

Желе , 24 19 байт

Это мой первый желейный ответ за долгое время. Рад вернуться.

Это порт моего ответа APL, который сам по себе является адаптацией многих алгоритмов, используемых здесь. Основное отличие состоит в том, что это 0-индексированный.

Изменить: -5 байтов благодаря Джонатану Аллану.

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

Ḋm2ɓṁḤ_
ŻJḟÇṂ;
1Ç¡U

объяснение

Ḋm2ɓṁḤ_  First link. Takes our current sequence S as our left argument.

         We are trying to calculate, of an arithmetic progression A B C, 
           the C using the formula, C = 2*B - A
Ḋ        Remove the first element of S.
 m2      Get every element at indices 0, 2, 4, ...
           This is equivalent to getting every second element of S, a list of As.
   ɓ     Starts a dyad with reversed arguments.
           The arguments here are S and As.
    ṁ    This molds S in the shape of As, giving us a list of Bs.
     Ḥ   We double the Bs.
      _  And subtract As from 2 * Bs.

ŻJḟÇṂ;  Second link. Takes S as our left argument.

Ż       Append a 0 to S.
 J      Range [1, len(z)]. This gets range [1, len(S) + 1].
  ḟÇ    Filter out the results of the previous link, our Cs.
    Ṃ   Take the minimum of Cs.
     ;  And concatenate it with the rest of the sequence so far.

1Ç¡U  Third link. Where we feed our input, n.

1     A list with the element 1.
 Ç¡   Run the previous link n times.
   U  Reverse everything at the end.
Sherlock9
источник
будет делать то же самое, что и œ-сохранение байта
Джонатан Аллан
Уверен, вы можете обнулить индекс (согласно последовательности ) и заменить“” с 1выводом представление Jelly списка из полной программы, экономя еще один.
Джонатан Аллан
Œœị@2можно сыграть в гольф, чтобы Ḋm2спасти двоих.
Джонатан Аллан
L‘Rможет быть игра в гольф, чтобы ŻJспасти один.
Джонатан Аллан
@JonathanAllan Пять целых байтов! Благодарность!
Sherlock9
1

ES6, 114 байт

n=>[...r=Array(n)].map((x,i,s)=>{for(y=1;x&&x[y];y++);r[i]=y;for(j=i;++j<n;s[j][y+y-r[i+i-j]]=1)s[j]=s[j]||[]}&&r

Возвращает массив первых n элементов последовательности, поэтому индексы равны 1 для версии без заглядывания ниже. Я использовал ситчатый подход. Эта версия замедляется примерно после n = 2000; предыдущая версия избегала считывания начала массива, что означало, что он не замедлялся до n = 2500. Более старая версия использовала массив sieve как список запрещенных значений, а не логический массив, значения которого были запрещены; это могло бы достигнуть приблизительно n = 5000, не ломая пот. Моя оригинальная версия пыталась использовать битовые маски, но это оказалось бесполезным (и также было слишком длинным в 198 байт).

Не очень медленная версия без гольфа:

function smoke(n) {
    result = [];
    sieve = [];
    for (i = 1; i <= n; i++) {
        value = 1;
        if (sieve[i]) {
            while (sieve[i][value]) {
                value++;
            }
        }
        result[i] = value;
        for (j = 1; j < i && i + j <= n; j++) {
            if (!sieve[i + j]) sieve[i + j] = [];
            sieve[i + j][value + value - result[i - j]] = true;
        }
    }
    return result;
}
Нил
источник