2014 dxdy logo

Научный форум dxdy

Математика, Физика, Computer Science, Machine Learning, LaTeX, Механика и Техника, Химия,
Биология и Медицина, Экономика и Финансовая Математика, Гуманитарные науки




Начать новую тему Ответить на тему На страницу Пред.  1, 2
 
 Re: Кубики и суммы
Сообщение02.09.2021, 16:18 


20/04/10
1230
Русь
С удовольствием. Приду с работы и выложу.

 Профиль  
                  
 
 Re: Кубики и суммы
Сообщение02.09.2021, 23:29 


20/04/10
1230
Русь
Пример для "классического" кубика-октаэдра. Определяем сумму и сумму квадратов на кубиках: $S_1=\sum _{i=1}^8 i, S_2=\sum _{i=1}^8 i^2.$ Вычисляем наибольшее возможное по модулю число на гранях, очевидно это $\lfloor\sqrt{S_2}\rfloor$. Далее обе суммы представляем в виде двух сумм $S_1=S_{11}+S_{12}$, $S_2=S_{21}+S_{22}$ (подразумеваем, что в каждом слагаемом сумма от четырёх граней); возможно, что тут оптимальнее будет представлять в виде суммы трёх или четырёх слагаемых, я поленился проверять. Это улучшение (оно существенно ускоряет счёт) я дописал после сообщения Sender. Будет двойной цикл по $S_{12}, S_{22}$, можно наоборот по $S_{11}, S_{12}$, но прежде определим две очевидные функции:
Код:
S21[S22_] := S2 - S22;
S11[S12_] := S1 - S12;
Цикл
Код:
S12S22 = {}; Do[
If[S12^2/4 <= S22 && S11[S12]^2/4 <= S21[S22],
  AppendTo[S12S22, {S12, S22}]], {S12, -4Floor[\sqrt{S_2}] 4Floor[\sqrt{S_2}]}, {S22, 0, S2}]
В нём пробегаем по всем возможным значениям $S_{12}$ и $S_{22}$; поскольку в сумме $S_{12}$ наибольшее возможное по модулю слагаемое равно $\lfloor\sqrt{S_2}\rfloor$, а всего слагаемых четыре, то пределы по $S_{12}$ от $-4\lfloor\sqrt{S_2}\rfloor$ до $4\lfloor\sqrt{S_2}\rfloor$ (тут, конечно, можно ещё существенно сузить интервал, но тоже поленился). В цикле делается проверка удовлетворяют ли пары $\{S12, S22\}$, $\{S11, S21\}$ неравенству для среднего арифметического и среднего квадратичного. На выходе имеем строку (одномерный массив) $S12S22$, в котором все допустимые суммы разбиения восьмигранного кубика на два четырёхгранных. Ищем для каждого элемента $S12S22$ решение и одновременно решение для сопряжённой пары $\{S11, S21\}$, если решения одновременно существуют, то будем комбинировать решения, цикл проходит по всем найденным разбиениям:
Код:
str = {}; Do[(s2 = Solve[{Sum[l[i], {i, 1, 4}] == S12S22[[j, 1]], Sum[l[i]^2, {i, 1, 4}] == S12S22[[j, 2]], l[1] <= l[2] <= l[3] <= l[4]}, Table[l[i], {i, 1, 4}], Integers]; s1 = Solve[{Sum[l[i + 4], {i, 1, 4}] == S11[S12S22[[j, 1]]], Sum[l[i + 4]^2, {i, 1, 4}] == S21[S12S22[[j, 2]]], l[5] <= l[6] <= l[7] <= l[8]}, Table[l[i], {i, 5, 8}], Integers]; If[Length[s1] != 0 && Length[s2] != 0, Do[AppendTo[str, Sort[Union[s1[[k]], s2[[kk]]]]], {k, 1, Length[s1]}, {kk, 1, Length[s2]}]]; If[IntegerQ[j/10], Print[j]]), {j, 1, Length[S12S22]}] // Timing
Можно не пользоваться встроенной функцией Solve, она с опцией Integers всё равно ищет целочисленные решения обычным перебором, но для маленького числа переменных (в нашем случае их четыре) ускорение по-моему не будет существенным. В цикле есть место
Код:
If[Length[s1] != 0 && Length[s2] != 0, Do[AppendTo[str, Sort[Union[s1[[k]], s2[[kk]]]]], {k, 1, Length[s1]}, {kk, 1, Length[s2]}]]
То есть если одновременно нашлись решения, то мы составляем из найденных решений всевозможные комбинации, они являются решениями для восьмигранника. Наконец, формируем отсортированный массив найденных решений и выбрасываем повторяющиеся:
Код:
STR = {}; Do[ AppendTo[STR, Sort[{Last[str[[i, 1]]], Last[str[[i, 2]]], Last[str[[i, 3]]], Last[str[[i, 4]]], Last[str[[i, 5]]], Last[str[[i, 6]]], Last[str[[i, 7]]], Last[str[[i, 8]]]}]], {i, 1, Length[str]}]
Union[STR]
Length[Union[STR]]
Ссылка на nb файл:
https://dropmefiles.com/Z3OPd
Кстати, пока писал сообщение подумал, что надо попробовать каждый раз разбивать суммы на два слагаемых, то есть собрать всё вышеописанное в одну процедуру и вызывать её рекурсивно. Почти уверен, что тогда до додекаэдра доберёмся очень легко. Ведь идея Sender ускоряет процесс в несколько раз.

 Профиль  
                  
 
 Re: Кубики и суммы
Сообщение03.09.2021, 08:37 
Заслуженный участник
Аватара пользователя


05/12/09
1405
Москва
Спасибо, интересно, обдумаю.

 Профиль  
                  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 18 ]  На страницу Пред.  1, 2

Модераторы: Модераторы Математики, Супермодераторы



Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group