Второе число Сахарова-Коидэ
\[ 4.955271... * 10^{-7} \]И опять Дмитрий Волов: всё те же одномерные динамики Ферхюльста-Рикера-Планка.
Здесь значение "a" получалось из очень приблизительного значения B = 0.188... , полученного от привязки к массам нейтрино. См. здесь:
https://priwalow-w.livejournal.com/24690.htmlТеперь же мы можем сделать ровно наоборот - подставить очень точное значение второго числа Сахарова и получить число "B".
B = 0.1904982;
a2 = 11; b2 = 17; s = 6301; n2 = 28737; d2 = 100;
xx = N[d2*s^(a2/b2) - n2, 50];
a = 2*xx;
x1 = 22.88; x2 = 22.97;
y2 = 5.106; y1 = 5.092;
BJIaquMup = Compile[{{J, _Real}}, ({J, #} &) /@ \
Union[Drop[NestList[J*#^B*(Exp[-#] + a) &, 1., 1200], 1000]]];
mm = Flatten[Table[BJIaquMup[J], {J, x1, x2, 5.0*10^(-6)}], 1];
ListPlot[mm, PlotStyle -> {AbsolutePointSize[.01],
Hue[.666]}, Frame -> True,
FrameStyle ->
GrayLevel[0.5], Axes -> False,
ImageSize -> {500, 500}, PlotRange -> {y1, y2}]
B = 0.1904982...
Точность этого числа зависит только от мощности вашего компьютера.
Но оно интересно не само по себе. Оказывается, оно сильно коррелирует с формулой фотона для одномерных динамик Ферхюльста-Рикера-Планка.
(*a = 1.190242;*)
a = 1.17633;
x1 = 1.000001; x2 = 1.0003;
y2 = 7.; y1 = 0;
Yulia = Compile[{{J, _Real}}, ({J, #} &) /@ \
Union[Drop[NestList[J/((#^(1/#))^(a^#)) &, 1., 200], 0]]];
mm = Flatten[Table[Yulia[J], {J, x1,
x2, 1.0*10^(-7)}], 1];
ListPlot[mm, PlotStyle -> {AbsolutePointSize[.01], Hue[.6]}, Frame ->
True, FrameStyle -> GrayLevel[0.5],
Axes -> False, ImageSize -> {500, 500}, PlotRange -> {y1, y2}]
Обратите внимание на уплотнение линий итераций вверху. Здесь такая картина соответствует числу 1.17633
А вот для числа 1.18
a = 1.18;(*a = 1.190242;*)
x1 = 1.000001; x2 = 1.0003;
y2 = 7.; y1 = 0;
Yulia = Compile[{{J, _Real}}, ({J, #} &) /@ \
Union[Drop[NestList[J/((#^(1/#))^(a^#)) &, 1., 200], 0]]];
mm = Flatten[Table[Yulia[J], {J, x1, x2, 1.0*10^(-7)}], 1];
ListPlot[mm, PlotStyle -> {AbsolutePointSize[.01], Hue[.6]}, Frame ->
True, FrameStyle ->
GrayLevel[0.5], Axes -> False, ImageSize -> {500, 500}, \
PlotRange -> {y1, y2}]
Нетрудно заметить, что плотность линий итераций сильно падает по мере продвижения к какому-то определённому числу.
И боюсь, что это число и есть
B = 0.1904982...
Программа очень несложная.
B = 0.1904982;
a = 1.190242`200;(* Этот увеличивает порог *)
kvo = 1500;(* Koличество итераций *)
F = 4.66920160910299067185320382046620161;
k = kvo - 17;(* Tilda *)
o = 1;(* Стартовое значение х *)
J = 1.000000000000000000000000000000000000000000000000000000000000000000000000\
00000000000000000000000000000000000000006265`200;
(* А этот уменьшает порог. Ho увеличивает количество итераций. А тот - нефига. *)
x = o;
yo = 1;
For[i = 1, i < kvo + 1,
y = N[J/((x^(1/x))^(a^x)), 200];
(*If[i > k && OddQ[i], Print[i". ", y - yo, " y= ", y]];*)
If[i > k && OddQ[i], Print[i". ", y - yo]];
If[OddQ[i], yo = y];
x = y;
i++];
Позволяет добраться разреженности линий итерации аж до 17.
Небольшое замечание:
Вплоть до этого значения J, что в тексте программы, J убывало довольно быстро, но здесь сильно затормозилось и дальнейшее увеличение числа "B" проходит с чудовищным скрипом. Что позволяет надеяться, что всё дело стремится именно к числу
0.1904982...
Кстати, ровно то же самое, что и с фотоном, происходит на формуле нейтрино. С той лишь разницей, что, если на фотоне всё это дело стремится к единице (я имею ввиду, уменьшение плотности линий итерации). А на нейтрино -- наоборот: такое уменьшение плотности линий итераций стремится к бесконечности. На фотоне просто полегче всё это дело проследить.
На нейтрино -- куда как сложнее.
