Аранжировка пузырей

26

Обратите внимание, вызов скопирован из вопроса, заданного на math.stackexchange .

Недавно я приобрел некоторые навыки выдувания пузырей. Сначала я бы пускал пузыри вот так: введите описание изображения здесь

Но потом все стало странным:

введите описание изображения здесь

Через некоторое время я начал пускать довольно странные пузыри:

введите описание изображения здесь

Выдув сотни, может быть, даже тысячи таких пузырьков, мой лоб внезапно сморщился от вопроса: учитывая n пузырьков, сколько разных способов вы можете их расположить? Например, если n = 1, существует только 1 расположение. Если n = 2, есть 2 расположения. Если n = 3, есть 4 договоренности. Если n = 4, есть 9 договоренностей.

Вот 9 аранжировок из 4 пузырьков:
введите описание изображения здесь введите описание изображения здесь введите описание изображения здесь введите описание изображения здесь введите описание изображения здесь введите описание изображения здесь введите описание изображения здесь введите описание изображения здесь введите описание изображения здесь

После того, как я взорвал все эти чудесные пузыри, я решил, что должен поделиться радостью, посчитав их договоренности с вами. Итак, вот ваша задача:


Цель

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


вход

nколичество пузырьков. n> 0


Выход

Количество способов, которыми вы можете расположить эти пузыри.


Критерии победы

Было бы очень здорово, если бы мы взорвали ваш код. Чем меньше вы делаете свой код, тем легче будет это сделать. Таким образом, тот, кто создаст код с наименьшим количеством байтов, выиграет конкурс.


Дополнительная информация

OEIS

Номер один
источник
5
Если пузыри могут пересекаться, то это открытая проблема с 173 решениями для n = 4 .
orlp
@orlp К счастью, эти пузыри не пересекаются.
TheNumberOne
1
Является 0действительным вход?
Мартин Эндер
@ KenY-N Да. Внизу уже есть ссылка OEIS
Роман
К сожалению! Удалить глупое время комментирования ...
Кен YN

Ответы:

12

Python 2, 92 87 байт

a=lambda n:n<2or sum((k%d<1)*d*a(d)*a(n-k)for k in range(1,n)for d in range(1,1+k))/~-n

На простом английском языке: для вычисления a(n)мы вычисляем d*a(d)*a(n-k)для каждого делителя dкаждого положительного целого числа, kменьшего или равного n, суммируем все это и делим на n-1.

Для того, чтобы сделать его работать быстрее, работать в Python 3 (замена /с //в приведенной выше функции) и memoize:

import functools
a = functools.lru_cache(None)(a)

Если вы сделаете это, он вычисляется a(50) = 425976989835141038353мгновенно.

orlp
источник
Ух ты, круто. Я предполагаю, что lru_cache()запоминает функцию?
Патрик Робертс
@PatrickRoberts Да, обычно он используется как декоратор функций, но вы также можете применить его к функции вручную.
orlp
@PatrickRoberts Вот документы дляlru_cache .
PM 2Ring
Эта функция возвращает Trueдля n<2. Я думаю, это нормально n=1, поскольку в Python Trueв числовом контексте оценивается как 1, но a(0)должно возвращать 0. Вы можете исправить это с помощью, n<2 and n or sum...но может быть более компактный способ.
PM 2Ring
Я предполагаю, что можно привести аргумент, что есть один способ упорядочить ноль пузырьков, но это не соответствует A000081. OTOH, если нам нужно только решить для положительного, nто мы можем смело игнорировать этот угловой случай, так как он не влияет на рекурсивные вызовы для более высокого n.
PM 2Ring
10

GNU Prolog, 98 байт

b(x,0,x).
b(T/H,N,H):-N#=A+B+1,b(H,A,_),b(T,B,J),H@>=J.
c(X,Y):-findall(A,b(A,X,_),L),length(L,Y).

Этот ответ является отличным примером того, как Prolog может бороться даже с простейшими форматами ввода-вывода. Он работает в истинном стиле Пролог через описание проблемы, а не алгоритм для ее решения: он определяет, что считается допустимым расположением пузырьков, просит Пролог генерировать все эти расположения пузырьков, а затем подсчитывает их. Генерация занимает 55 символов (первые две строчки программы). Подсчет и ввод / вывод занимают остальные 43 (третья строка и новая строка, разделяющая две части). Могу поспорить, что это не проблема, которую OP ожидал, что языки будут бороться с I / O! (Примечание: подсветка синтаксиса в стеке Exchange затрудняет чтение, а не упрощает, поэтому я отключил его).

объяснение

Давайте начнем с псевдокодовой версии аналогичной программы, которая на самом деле не работает:

b(Bubbles,Count) if map(b,Bubbles,BubbleCounts)
                and sum(BubbleCounts,InteriorCount)
                and Count is InteriorCount + 1
                and is_sorted(Bubbles).
c(Count,NPossibilities) if listof(Bubbles,b(Bubbles,Count),List)
                       and length(List,NPossibilities).

Должно быть достаточно ясно, как bработает: мы представляем пузырьки через отсортированные списки (которые представляют собой простую реализацию мультимножеств, которая заставляет равные мультимножества сравнивать равные), и один пузырь []имеет счетчик 1, а большой пузырь имеет счетчик равно общему количеству пузырьков внутри плюс 1. Для счетчика 4 эта программа (если бы она работала) генерировала следующие списки:

[[],[],[],[]]
[[],[],[[]]]
[[],[[],[]]]
[[],[[[]]]]
[[[]],[[]]]
[[[],[],[]]]
[[[],[[]]]]
[[[[],[]]]]
[[[[[]]]]]

Эта программа непригодна в качестве ответа по нескольким причинам, но наиболее неотложной является то, что у Пролога на самом деле нет mapпредиката (и написание этого заняло бы слишком много байтов). Так что вместо этого мы пишем программу более похожую на эту:

b([], 0).
b([Head|Tail],Count) if b(Head,HeadCount)
                    and b(Tail,TailCount)
                    and Count is HeadCount + TailCount + 1
                    and is_sorted([Head|Tail]).
c(Count,NPossibilities) if listof(Bubbles,b(Bubbles,Count),List)
                       and length(List,NPossibilities).

Другая важная проблема заключается в том, что при запуске он входит в бесконечный цикл из-за того, как работает порядок оценки Пролога. Тем не менее, мы можем решить бесконечный цикл, слегка переставив программу:

b([], 0).
b([Head|Tail],Count) if Count #= HeadCount + TailCount + 1
                    and b(Head,HeadCount)
                    and b(Tail,TailCount)
                    and is_sorted([Head|Tail]).
c(Count,NPossibilities) if listof(Bubbles,b(Bubbles,Count),List)
                       and length(List,NPossibilities).

Это может выглядеть довольно странно - мы суммируем значения до того, как узнаем, что они есть, но GNU Prolog #=способен обрабатывать такие некаузальные арифметики, и потому что это самая первая строка b, HeadCountи TailCountоба должны быть меньше чем Count(что известно), он служит способом естественного ограничения количества совпадений рекурсивного члена и, таким образом, приводит к тому, что программа всегда завершается.

Следующим шагом будет немного поиграть в гольф. Удаление пробелов, использование односимвольных имен переменных, использование аббревиатур, таких как :-for ifи ,for and, использование setofвместо listof(у него более короткое имя и в этом случае такие же результаты) и использование sort0(X,X)вместо is_sorted(X)(потому что на is_sortedсамом деле не является реальной функцией, Я сделал это)

b([],0).
b([H|T],N):-N#=A+B+1,b(H,A),b(T,B),sort0([H|T],[H|T]).
c(X,Y):-setof(A,b(A,X),L),length(L,Y).

Это довольно коротко, но это возможно сделать лучше. Ключевое понимание заключается в том, что [H|T]в действительности синтаксисы списков действительно многословны. Как знают программисты на Лиспе, список в основном состоит из cons-ячеек, которые в основном являются просто кортежами, и вряд ли какая-либо часть этой программы использует встроенные списки. У Пролога есть несколько очень коротких синтаксисов кортежей (мой любимый A-B, но мой второй любимый A/B, который я использую здесь, потому что в этом случае он дает более легкий для чтения отладочный вывод); и мы можем также выбрать наш собственный односимвольный символ nilв конце списка, вместо того, чтобы застрять с двухсимвольным символом [](я выбрал x, но в основном все работает). Таким образом, вместо [H|T], мы можем использовать T/H, и получить вывод изb это выглядит так (обратите внимание, что порядок сортировки в кортежах немного отличается от порядка в списках, поэтому они не находятся в том же порядке, что и выше):

x/x/x/x/x
x/x/x/(x/x)
x/(x/x)/(x/x)
x/x/(x/x/x)
x/(x/x/x/x)
x/x/(x/(x/x))
x/(x/x/(x/x))
x/(x/(x/x/x))
x/(x/(x/(x/x)))

Это довольно трудно читать, чем вложенные списки выше, но это возможно; мысленно пропустите xs и интерпретируйте /()как пузырь (или просто /как вырожденный пузырь без содержимого, если нет ()после него), и элементы имеют соответствие 1-к-1 (если неупорядочено) с версией списка, показанной выше ,

Конечно, это представление списка, несмотря на то, что оно намного короче, имеет большой недостаток; он не встроен в язык, поэтому мы не можем sort0проверить, отсортирован ли наш список. sort0В любом случае это довольно многословно, поэтому выполнение этого вручную не является огромной потерей (фактически, выполнение этого вручную в [H|T]представлении списка приводит к одинаковому количеству байтов). Ключевым моментом здесь является то, что программа в письменном виде проверяет, отсортирован ли список, отсортирован ли его хвост, отсортирован ли его хвост и т. Д .; Есть много избыточных проверок, и мы можем использовать это. Вместо этого мы просто проверим, чтобы первые два элемента были в порядке (что гарантирует, что список будет отсортирован, как только сам список и все его суффиксы проверены).

Первый элемент легко доступен; это только глава списка H. Второй элемент довольно сложен для доступа, и может не существовать. К счастью, xэто меньше, чем все рассматриваемые нами кортежи (через обобщенный оператор сравнения Prolog @>=), поэтому мы можем считать «вторым элементом» одноэлементного списка xи программа будет работать нормально. Что касается фактического доступа ко второму элементу, самый краткий метод состоит в добавлении третьего аргумента (аргумента out) b, который возвращается xв базовом и Hрекурсивном случаях; это означает, что мы можем получить головку хвоста как результат второго рекурсивного вызова B, и, конечно, голова хвоста является вторым элементом списка. Так bвыглядит сейчас:

b(x,0,x).
b(T/H,N,H):-N#=A+B+1,b(H,A,_),b(T,B,J),H@>=J.

Базовый случай достаточно прост (пустой список, возвращает счетчик 0, «первый элемент» пустого списка x). Рекурсивный случай начинается так же, как и раньше (только с T/Hнотации , а не [H|T], и в Hкачестве дополнительного аргумента из); мы игнорируем дополнительный аргумент из рекурсивного вызова на голове, но сохраняем его в Jрекурсивном вызове на хвосте. Затем все, что нам нужно сделать, - это убедиться, что Hоно больше или равно J(т. Е. «Если в списке есть хотя бы два элемента, первый больше или равен второму), чтобы гарантировать, что список будет отсортирован.

К сожалению, setofон подходит, если мы пытаемся использовать предыдущее определение cвместе с этим новым определением b, потому что оно обрабатывает неиспользуемые параметры более или менее так же, как SQL GROUP BY, что совсем не то, что мы хотим. Можно перенастроить его на то, что мы хотим, но это перенастройка стоит символов. Вместо этого мы используем findall, который имеет более удобное поведение по умолчанию и длиннее всего на два символа, давая нам следующее определение c:

c(X,Y):-findall(A,b(A,X,_),L),length(L,Y).

И это полная программа; кратко генерируйте шаблоны пузырьков, затем тратите целую массу байтов, считая их (нам нужно довольно много времени, findallчтобы преобразовать генератор в список, а затем, к сожалению, многословно назвать его, lengthчтобы проверить длину этого списка, плюс шаблон для объявления функции).


источник
«На самом деле у Пролога нет предиката карты» : у Пролога есть maplist/2-8предикат , хотя я не уверен, что это сделает ситуацию короче.
фатализировать
@Fatalize: Да, похоже, что это было добавлено в более новой версии. Его нет в документации по установке, которая у меня есть, и она не работает на практике:| ?- maplist(reverse,[A,B]). uncaught exception: error(existence_error(procedure,maplist/2),top_level/0)
Это действительно странно; maplistявляется очень часто используемым предикатом, который предоставляется в основных дистрибутивах Пролога (таких как SWI-Prolog и SiCStus)
Fatalize
10

Mathematica, 68 байт

Бьюсь об заклад, это может быть побеждено (даже в Mathematica) с нуля, но вот встроенная версия:

<<NumericalDifferentialEquationAnalysis`
Last@ButcherTreeCount[#+1]&

ButcherTreeCountимеет индекс 0, отсюда [#+1]и возвращает список всех значений вплоть до аргумента, отсюда Last@. Но в остальном это просто встроенная функция для этой функции. Однако, это требует загрузки пакета, что и делает первая строка.

Грег Мартин
источник
8
«Конечно, у Mathematica есть для этого встроенная функция».
orlp