Entrada destacada

Distancia media de dos puntos en un cuadrado unitario

martes, 25 de julio de 2017

Conjetura de Andrica


Dada a conocer por el matemático Rumano Dorin Andrica en 1978, se une a las diferentes conjeturas que establecen el crecimiento de la sucesión de los números primos. Su enunciado original es:




Buscando entre los primeros número primos alguno que incumpla la condición de Andrica:



como es de esperarse da vacío.

numero = 100;
andrica = {};
Do[If[Sqrt@Prime[k + 1] - Sqrt@Prime[k] >= 1, 
   AppendTo[andrica, Prime[k]]], {k, numero}];
andrica

{}

Buscamos las parejas de primos para los cuales la condición de Andrica sea mayor que 0.5

numero = 100000;
andrica = {};
Do[If[Sqrt@Prime[k + 1] - Sqrt@Prime[k] >= 0.5, 
   AppendTo[
    andrica, {Prime[k], Prime[k + 1], 
     N[Sqrt@Prime[k + 1] - Sqrt@Prime[k]]}]], {k, numero}];
andrica

{{3, 5, 0.504017}, {7, 11, 0.670873}, {13, 17, 0.517554},
 {23, 29, 0.589333}, {31, 37, 0.514998}, {113, 127, 0.639282}}

El valor de 0.670873 que se encuentra entre los primos consecutivos 7 y 11, es el mayor que se ha podido determinar y se conjetura que es la cota máxima para la condición de Andrica.

Graficando la condición de Andrica: P(n) vs. condición de Andrica

numero = 200;
andrica = {};
Do[AppendTo[
   andrica, {Prime[k], N[Sqrt@Prime[k + 1] - Sqrt@Prime[k]]}], {k, 
   numero}];
gra1 = Show[
  Plot[{1, 0.5}, {x, 0, Prime[numero + 1]}, 
   PlotRange -> {-0.1, 1.02}], g = ListPlot[Tooltip@andrica]]














Se generan unas curvas agrupando los números primos, desde la curva inferior tenemos:

curva1 = {3, 5, 11, 17, 29, 41, 59, 71, 101, 107, 137, 149, 179,                               191, 197, 227, 239, 269, 281, 311, 347, 419, 431, 461, 521};
curva2 = {7, 13, 37, 43, 67, 79, 97, 103, 109, 127, 163, 193, 223, 
   229, 277, 307, 313, 349, 379, 397, 439, 457, 463, 487, 499};
curva3 = {23, 31, 47, 53, 61, 73, 83, 131, 151, 157, 167, 173, 233, 
   251, 257, 263, 271, 331, 353, 367, 373, 383, 433, 443, 503, 541};
curva4 = {89, 359, 401, 449, 479, 491};
curva5 = {139, 181, 241, 283, 337, 409, 421};
curva6 = {199, 211, 467, 509};
curva7 = {113, 293, 317};
curva9 = {523};

¿Qué característica tienen los primos que conforman cada curva? 

Para los primos en la curva1 generamos la lista conformada por el número primo junto con su condición de Andrica:

andrica1 = {};
Do[If[MemberQ[curva1, andrica[[k, 1]]], 
   AppendTo[andrica1, andrica[[k]]]], {k, Length[andrica]}];
andrica1

{{3, 0.504017}, {5, 0.409683}, {11, 0.288926}, {17, 0.235793}, 
{29, 0.1826}, {41, 0.154314}, {59, 0.129104}, {71, 0.117854}, 
{101, 0.0990159}, {107, 0.0962261}, {137, 0.0851262}, {149, 
  0.0816501}, {179, 0.0745359}, {191, 0.072169}, 
{197, 0.0710671}, {227, 0.0662268}, {239, 0.0645499}, 
{269, 0.0608582}, {281, 0.0595492}, {311, 0.0566139}, 
{347, 0.0536057}, {419, 0.048795}, {431, 0.0481126}, 
{461, 0.0465242}, {521, 0.0437688}}

Utilizando como modelo a/x^b ajustamos los datos:

Clear[a, b]
modelo1 = a/x^b;
v1 = FindFit[andrica1,  modelo1, {a, b}, x]

{a -> 0.857054, b -> 0.466001}

Graficando el modelo sobre los puntos de la curva1, obtenemos:

Show[ListPlot[andrica1, PlotStyle -> Red], 
 Plot[ modelo1 /. v1, {x, -1, 550}]]














Comportamiento y curva de ajuste para la curva2

andrica2 = {};
Do[If[MemberQ[curva2, andrica[[k, 1]]], 
   AppendTo[andrica2, andrica[[k]]]], {k, Length[andrica]}];
andrica2;

g2 = ListPlot[andrica2, PlotStyle -> Green];

modelo2 = a/x^b;
v2 = FindFit[andrica2,  modelo2, {a, b}, x]

{a -> 1.68999, b -> 0.467297}

Show[g2, Plot[ modelo2 /. v2, {x, 1, 550}]]














(Así para las demás curvas ).....

Asumiendo como modelo para la manipulación a/x^0.48

Manipulate[
 Show[g, Plot[{0.857054/x^0.5, 1.68999/x^0.467297, 
    13.68999/x^0.467297, a/x^0.48}, {x, 0, Prime[numero]}]], {a, 0.5,15}]















Formando el conjunto de los coeficientes encontrados en el ajuste para numero =100

v = {{a, b} /. v1, {a, b} /. v2, {a, b} /. v3, {a, b} /. 
   v4, {a, b} /. v5, {a, b} /. v6, {a, b} /. v7}

{{0.857054, 0.466001}, {1.68999, 0.467297}, {2.68351, 0.480468}, {3.72879, 0.48919}, {4.66372, 0.489311}, {5.62254, 0.490486}, {6.22775, 0.481538}}

{a, b} = Transpose[v]

{{0.857054, 1.68999, 2.68351, 3.72879, 4.66372, 5.62254, 
  6.22775}, {0.466001, 0.467297, 0.480468, 0.48919, 0.489311, 
  0.490486, 0.481538}}

Realizando el ajuste para los numeradores

a
{0.857054, 1.68999, 2.68351, 3.72879, 4.66372, 5.62254, 6.22775}

ga = ListPlot[a];

{m, n} = {m, n} /. FindFit[a,  m x + n, {m, n}, x]
{0.927051, -0.069153}

aa[x_] := m x + n
Show[ga, Plot[aa[x], {x, 0, 10}]]















Podemos concluir que los exponentes de los denominadores es aproximadamente 0.48 y para los numeradores ellos se comportan como la función idéntica. Pero este comportamiento es fácilmente explicable realizando el siguiente cálculo:














donde dist(n)=P(n+1)-P(n) la distancia entre el número primo P(n) y el siguiente número primo. Así, la condición de Andrica es aproximadamente igual a la mitad de la distancia entre los primos consecutivos dividido por la raíz cuadrada del primer primo.

Por tanto, los elementos de curva1 corresponde al primer elemento de las parejas de los primos gemelos (publicado el 10 de octubre de 2016), curva2 corresponde al primer elemento de la pareja de los primos primos (Cousin Primes) parejas de primos consecutivos que distan 4 unidades, curva3 corresponde al primer elemento de las parejas de los primos sexis (de six) distan 6 unidades, y así sucesivamente.

Formemos los elementos de cada curva, para curva1 (primos gemelos):

numero = 100;
dist = 2;
curva = {};
Do[If[NextPrime[Prime[k]] == Prime[k] + dist, 
   AppendTo[curva, Prime[k]]], {k, numero}];
curva

{3, 5, 11, 17, 29, 41, 59, 71, 101, 107, 137, 149, 179, 191, 197,
227, 239, 269, 281, 311, 347, 419, 431, 461, 521}

para curva2 (primos primos) :

numero = 100;
dist = 4;
curva = {};
Do[If[NextPrime[Prime[k]] == Prime[k] + dist, 
   AppendTo[curva, Prime[k]]], {k, numero}];
curva

{7, 13, 19, 37, 43, 67, 79, 97, 103, 109, 127, 163, 193, 223, 229, 
277, 307, 313, 349, 379, 397, 439, 457, 463, 487, 499}

Si se logra probar la conjetura de Andrica para los primeros elementos de cada conjunto se tiene para todos los demás, pues las curvas son estrictamente decrecientes.

Prime[30]
113

Generalización de la Conjetura de Andrica

Consideramos como condición de Andrica (P(n+1)^x) - P(n)^x=1 y buscamos el valor de x para que se cumpla la ecuación para cada primo P(n), esta generalización de la Conjetura de Andrica fue propuesta por el matemático Florentin Smarandache. Calculando el valor de x para los 100 primeros primos encontramos

exp = Table[{Prime[k], 
   x /. FindRoot[Prime[k + 1]^x - Prime[k]^x - 1, {x, 0}, 
     AccuracyGoal -> 2]}, {k, 1, 150}]

{{2, 1.}, {3, 0.72716}, {5, 0.763224}, {7, 0.599687}, {11,0.807162}, {13, 0.647982}, {17, 0.826353}, {19, 0.674101}, {23, 0.604285}, 
{29, 0.845674}, {31, 0.625184}, {37, 0.713644}, {41, 0.856124}, 
{43, 0.721532}, {47, 0.651466}, {53, 0.658611}, {59, 0.865927}, 
{61, 0.666638}, {67, 0.74285}, {71, 0.87046}, {73, 0.676499}, 
{79, 0.75018}, {83, 0.683305}, {89, 0.639743}, {97, 0.758511}, 
{101, 0.878334}, {103, 0.760961}, {107, 0.879535}, {109, 0.7633}, {113, 0.567263}, {127, 0.768838}, {131, 0.705433}, {137, 0.884411}, {139, 0.629748}, {149, 0.885975}, {151, 0.711836}, {157, 0.713561}, {163, 0.777743}, {167, 0.716273}, {173, 0.717814}, {179, 0.889241}, {181, 0.643674}, {191, 0.89035}, {193, 0.783424}, {197, 0.890871}, {199, 0.622303}, {211, 0.625416}, {223, 0.788076}, {227, 0.893197}, {229, 0.788911}, {233, 0.729931}, {239, 0.894019}, {241, 0.657962}, {251, 0.732611}, {257, 0.733513}, {263, 0.734389}, {269, 0.895861}, {271, 0.735519}, {277, 0.79472}, {281, 0.896527}, {283, 0.665445}, {293, 0.620951}, {307, 0.797736}, {311, 0.898043}, {313, 0.798294}, {317, 0.625039}, {331, 0.742839}, {337, 0.6732}, {347, 0.899635}, {349, 0.801379}, {353, 0.745115}, {359, 0.706254}, {367, 0.746473}, {373, 0.747036}, {379, 0.803654}, {383, 0.747948}, {389, 0.709492}, {397, 0.804911}, {401, 0.710728}, {409, 0.681575}, {419, 0.902272}, {421, 0.682801}, {431, 0.90301}, {433, 0.752103}, {439, 0.80758}, {443, 0.752863}, {449, 0.714876}, {457, 0.808626}, {461, 0.903724}, {463, 0.808963}, {467, 0.663225}, {479, 0.717292}, {487, 0.810257}, {491, 0.718206}, {499, 0.810874}, {503, 0.75701}, {509, 0.666934}, {521, 0.905185}, {523, 0.616766}, {541, 0.75933}, {547, 0.693332}, {557, 0.760247}, {563, 0.760583}, {569, 0.906282}, {571, 0.761023}, {577, 0.695447}, {587, 0.761881}, {593, 0.762196}, {599, 0.906919}, {601, 0.762609}, {607, 0.762914}, {613, 0.815926}, {617, 0.907283}, {619, 0.675145}, {631, 0.699026}, {641, 0.907995}, {643, 0.817059}, {647, 0.764858}, {653, 0.765136}, {659, 0.90824}, {661, 0.677853}, {673, 0.818127}, {677, 0.766219}, {683, 0.729897}, {691, 0.702221}, {701, 0.73078}, {709, 0.703173}, {719, 0.731636}, {727, 0.76833}, {733, 0.768571}, {739, 0.82028}, {743, 0.732738}, {751, 0.769279}, {757, 0.820825}, {761, 0.733535}, {769, 0.82118}, {773, 0.66502}, {787, 0.70698}, {797, 0.685065}, {809, 0.910675}, {811, 0.708058}, {821, 0.91082}, {823, 0.822695}, {827, 0.910893}, {829, 0.708842}, {839, 0.668369}, {853, 0.823484}, {857, 0.911254}, {859, 0.823638}, {863, 0.669514}}

Graficando el primo P (n) vs. el valor del exponente x :

Show[ListPlot[Tooltip[exp]], Plot[{0.6, 0.7, 0.8, 0.9}, {x, 0, 550}]]















Observamos como los primos de curva1, primer primo de las parejas de primos gemelos, forman la curva superior que crece asintóticamente a 0.9, y las demás curvas se forman por debajo con el mismo modelo. Se conjetura que el menor valor de x es el que se encuentra para P(30)=113 que corresponde a x=0.567148... que se conoce como la Constante de Smarandache.

Ejercicio

Determinar el modelo que ajusta el comportamiento en la Generalización de la Conjetura de Andrica.


Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas


No hay comentarios.:

Publicar un comentario