Help wanted to find out if bounding function is pierced for n even > 10^7.
- To: mathgroup at smc.vnet.net
- Subject: [mg49609] Help wanted to find out if bounding function is pierced for n even > 10^7.
- From: gilmar.rodriguez at nwfwmd.state.fl.us (Gilmar Rodr?guez Pierluissi)
- Date: Sat, 24 Jul 2004 03:48:16 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
The function B[n] = (360.874) / (Exp[2 / Log[n]] - 1) is a bounding function
for all Minimal Goldbach Prime Partition Points ("MGPPP's" for short),
for all even integers n between (and including) 4 and 10^8.
(For a definition of MGPPP please visit:
http://forums.wolfram.com/mathgroup/archive/2004/Jul/msg00358.html)
The above statement can be (visually) verified using Mathematica (version 5)
as follows (please, bear with me):
The following first two command lines are used to calculate the MGPPP's
for all even integers n between 4 and 10^7, and then rotate these points
by a clockwise angle of Pi / 4 radians:
In[1]:
ROTMGPP[n_] := Module[{rotp, rotq}, {m = n/2; If[Element[m, Primes],
{p = m, q = m, rotp = 0.707107(p + q),
rotq = 0.707107(-p + q)},
{k = PrimePi[m]; Do[If[Element[n - Prime[i], Primes],
hit = i; Break[]], {i, k, 1, -1}], p = Prime[hit],
q = n - p,rotp = 0.707107(p + q),
rotq = 0.707107(-p + q)}]};{rotp, rotq}]
In[2]:
data = Table[ROTMGPP[n], {n, 4, 10^7, 2}];
Remark: Calculating this data set takes a little over two hours of
CPU time using my puny Intel(R) Pentium(R) 4 CPU 2 GHz computer.
(Hopefully, it will take much less time on your PC!)
The next two commands are used to sort and isolate those points
that are monotonically increasing in our data set:
In[3]:
Maxima[B_]:= Module[{M}, {M = {}; AppendTo[M, B[[1]]];{Xg,Yg}=B[[1]];
Do[If[Yg <= B[[i + 1]][[2]], {{Xg, Yg} = B[[i + 1]],
AppendTo[M, B[[i + 1]]]}], {i, 1, Length[B] - 1}]}; M]
In[4]:
M = Maxima[A]
Next we plot our data set and the set M to visualize them:
In[5]:
Plt1 = ListPlot[data, AspectRatio ->1\/GoldenRatio,PlotJoined->True,
PlotLabel -> "MINIMAL GOLDBACH PRIME PARTITION POINTS FOR
EVEN INTEGERS N BETWEEN 4 and 10^7 (DEPICTED IN RED).",
FrameLabel -> {"", "BOUNDING FUNCTION (DEPICTED IN BLUE).",
"PLANE ROTATED CLOCKWISE BY AN ANGLE THETA = p/4 RADIANS
ABOUT THE ORIGIN.>", ""}, Frame -> True, PlotStyle->{Hue[1],
{RGBColor[0, 0, 1]}, Thickness[ .001]},
Background -> RGBColor[1, 1, 0],ImageSize->800,PlotRange->All]
In[6]:
Plt2 = ListPlot[M, AspectRatio ->1\/GoldenRatio, PlotJoined->True,
PlotLabel -> "MINIMAL GOLDBACH PRIME PARTITION POINTS FOR
EVEN INTEGERS N BETWEEN 4 and 10^7 (DEPICTED IN RED).",
FrameLabel -> {"", "BOUNDING FUNCTION (DEPICTED IN BLUE).",
"PLANE ROTATED CLOCKWISE BY AN ANGLE THETA = p/4 RADIANS
ABOUT THE ORIGIN.>", ""}, Frame -> True,
PlotStyle->{Hue[0.7],{RGBColor[0, 0, 1]}, Thickness[ .001]},
Background->RGBColor[1, 1, 0],ImageSize->800,PlotRange->All]
In[7]:
Show[Plt1, Plt2]
Next we want to use the following two "tactical" points in M,
to get the above mentioned bounding function
B[n] = (360.874)/(Exp[2/Log[n]]-1) via NonlinearFit:
In[8]:
tacticalpts = {M[[1]], M[[Length[M] - 2]]}
In[9]:
<< Statistics`NonlinearFit`
In[10]:
BF[n_]=NonlinearFit[tacticalpts,Alpha/(Exp[2/Log[n]]-1),{n},{Alpha}]
In[11]:
BoundSet=Table[{M[[i]][[1]], BF[M[[i]][[1]]]},{i,1,Length[M]}]
Finally, we plot our data set and its bounding function:
In[12]:
Plt3 = ListPlot[BoundSet,AspectRatio->1\/GoldenRatio,PlotJoined->True,
PlotLabel -> "MINIMAL GOLDBACH PRIME PARTITION POINTS FOR
EVEN INTEGERS N BETWEEN 4 and 10^7 (DEPICTED IN RED).",
FrameLabel -> {"", "BOUNDING FUNCTION (DEPICTED IN BLUE).",
"PLANE ROTATED CLOCKWISE BY AN ANGLE THETA = p/4 RADIANS
ABOUT THE ORIGIN.>", ""}, Frame -> True, PlotStyle->{Hue[0.7],
{RGBColor[0, 0, 1]}, Thickness[ .001]},
Background->RGBColor[1, 1, 0], ImageSize->800, PlotRange->All]
In[13]:
Show[Plt3, Plt1]
For a picture of this plot please visit:
http://gilmarlily.netfirms.com/goldbach/10^7plot.htm
or download and evaluate the notebook:
http://gilmarlily.netfirms.com/download/bf(4,10to7).nb
At this juncture, one gets excited with
B[n] = (360.874) / (Exp[2 / Log[n]] - 1)
and the possibility that this function might bound the
MGPPP's for ALL even n's. However; being mathematically prudent,
I seek MGPPP's that can pierce the above bounding function for n
even greater than 10^7. I attempt to reach the "10^8 mark" by
repeating the above 13 steps on the interval [4 , 10^8],
but (unfortunately) the trial:
data = Table[ROTMGPP[n], {n, 4, 10^8, 2}];
ends with a message:
"No more memory available. Mathematica kernel has shut down.
Try quitting other applications and then retry."
A pun of Fermat's last theorem comes to mind:
"I have a heuristic proof that
B[n] = (360.874) / (Exp[2 / Log[n]] - 1) is
a bounding function for the MGPPP's on the interval [4,Infinity)
but the memory of my PC is too small to show this." [LOL]
Other attempts to lessen the weight of the task by partitioning
it into smaller jobs via:
data2 = Table[ROTMGPP[n], {n,10^7,10^8,2}];
data3 = Table[ROTMGPP[n], {n,10^8,10^9,2}]; etc.
end in the same manner.
My PC can handle PrimePi[10^14] =3204941750802,
so the evaluation of ROTMGPP[(10^8)/2] is not the problem.
Only for PrimePi[10^15](or PrimePi[] evaluated at higher
powers of 10),do I get the "PrimePi::largp" warning message.
Would anyone with better computer resources than I have, be kind
to do the necessary evaluation Table[ROTMGPP[n], {n, 4, 10^?, 2}]
to find out if the above bounding function is pierced for n even
greater than 10^7 ?
Please, let us know. Thank you!