Entrada destacada

Distancia media de dos puntos en un cuadrado unitario

viernes, 28 de julio de 2017

Frase Célebre de Galileo Galilei

El gran libro de la naturaleza 
yace siempre abierto ante nuestros ojos 
y en él está escrita la verdadera filosofía...
Pero no podemos leerla 
a menos que primero aprendamos  
el lenguaje en el que está escrito...
Está escrito en lenguaje matemático.

Galileo Galilei

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


viernes, 21 de julio de 2017

Frase Célebre de Karl Friedrich Gauss

Las matemáticas, 
sólo se revelan a aquellos 
que tienen el valor de profundizar en ellas.

Karl Friedrich Gauss

martes, 18 de julio de 2017

Números de Smarandache-Wellin


Los Números de Smarandache - Wellin son los términos de la sucesión que se forma concatenando los números primos comenzando por 2, parecido a la Constante de Copeland-Erdös.

swellin = {2};
Do[AppendTo[swellin, 
  FromDigits@
   Join[IntegerDigits@Last[swellin], IntegerDigits@Prime[n]]], {n, 2, 
  20}]
swellin

{2, 23, 235, 2357, 235711, 23571113, 2357111317, 235711131719, 23571113171923, 2357111317192329, 235711131719232931, 23571113171923293137, 2357111317192329313741,
235711131719232931374143, 23571113171923293137414347, 2357111317192329313741434753, 235711131719232931374143475359, 23571113171923293137414347535961, 2357111317192329313741434753596167, 235711131719232931374143475359616771}

Primos de Smarandache - Wellin

Son los términos de la sucesión anterior que son números primos,

Select[swellin, PrimeQ]
{2, 23, 2357}

en la lista swellin, donde se han concatenado los 20 primeros números primos, únicamente encontramos tres números que son Primos de Smarandache-Wellin. Lo anterior porque el siguiente número en la lista es bastante grande, calculemos de otra forma

pswellin = 
 Cases[FromDigits /@ 
   Rest[FoldList[Join, {}, IntegerDigits[Prime[Range[10^3]]]]], _?
   PrimeQ]

{2, 23, 2357,
2357111317192329313741434753596167717379838997101103107109113127131137139149151157163167173179181191193197199211223227229233239241251257263269271277281283293307311313317331337347349353359367373379383389397401409419421431433439443449457461463467479487491499503509521523541547557563569571577587593599601607613617619631641643647653659661673677683691701709719, 2357111317192329313741434753596167717379838997101103107109113127131137139149151157163167173179181191193197199211223227229233239241251257263269271277281283293307311313317331337347349353359367373379383389397401409419421431433439443449457461463467479487491499503509521523541547557563569571577587593599601607613617619631641643647653659661673677683691701709719727733739743751757761769773787797809811821823827829839853857859863877881883887907911919929937941947953967971977983991997100910131019102110311033,
2357111317192329313741434753596167717379838997101103107109113127131137139149151157163167173179181191193197199211223227229233239241251257263269271277281283293307311313317331337347349353359367373379383389397401409419421431433439443449457461463467479487491499503509521523541547557563569571577587593599601607613617619631641643647653659661673677683691701709719727733739743751757761769773787797809811821823827829839853857859863877881883887907911919929937941947953967971977983991997100910131019102110311033103910491051106110631069108710911093109711031109111711231129115111531163117111811187119312011213121712231229123112371249125912771279128312891291129713011303130713191321132713611367137313811399140914231427142914331439144714511453145914711481148314871489149314991511152315311543154915531559156715711579158315971601160716091613161916211627163716571663166716691693169716991709172117231733174117471753175917771783178717891801181118231831184718611867187118731877187918891901190719131931193319491951197319791987199319971999200320112017202720292039205320632069208120832087208920992111211321292131213721412143215321612179220322072213222122372239224322512267226922732281228722932297,
2357111317192329313741434753596167717379838997101103107109113127131137139149151157163167173179181191193197199211223227229233239241251257263269271277281283293307311313317331337347349353359367373379383389397401409419421431433439443449457461463467479487491499503509521523541547557563569571577587593599601607613617619631641643647653659661673677683691701709719727733739743751757761769773787797809811821823827829839853857859863877881883887907911919929937941947953967971977983991997100910131019102110311033103910491051106110631069108710911093109711031109111711231129115111531163117111811187119312011213121712231229123112371249125912771279128312891291129713011303130713191321132713611367137313811399140914231427142914331439144714511453145914711481148314871489149314991511152315311543154915531559156715711579158315971601160716091613161916211627163716571663166716691693169716991709172117231733174117471753175917771783178717891801181118231831184718611867187118731877187918891901190719131931193319491951197319791987199319971999200320112017202720292039205320632069208120832087208920992111211321292131213721412143215321612179220322072213222122372239224322512267226922732281228722932297230923112333233923412347235123572371237723812383238923932399241124172423243724412447245924672473247725032521253125392543254925512557257925912593260926172621263326472657265926632671267726832687268926932699270727112713271927292731274127492753276727772789279127972801280328192833283728432851285728612879288728972903290929172927293929532957296329692971299930013011301930233037}

Length[pswellin]
7

IntegerLength[pswellin]
{1, 2, 4, 355, 499, 1171, 1543}

Concatenando hasta los primeros 1000 números primos, obtenemos 7 números primos de Smarandache-Wellin con una longitud de dígitos de: {1, 2, 4, 355, 499, 1171, 1543}


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


sábado, 15 de julio de 2017

Frase Célebre de Maryam Mirzakhani

La Belleza de las matemáticas 
solo se evidencia a sus discípulos más pacientes


Maryam Mirzakhani

Matemática Iraní, en 2014 se convierte en la primera mujer a quien se le concede la Medalla Fields. Lamentablemente muere hoy a la edad de 40 años.

martes, 11 de julio de 2017

Espiral de Sacks


Construida por Robert Sacks en 1994. Se parte de una espiral de Arquimedes, en radianes el radio es una función lineal creciente que depende del ángulo, tomaremos la más sencilla posible la función idéntica r = θ :

PolarPlot[θ, {θ, 0, 20}, Ticks -> None]



y se ubican los números naturales sobre ella en orden empezando desde cero, de tal forma que los números cuadrados perfectos se ubiquen sobre el eje real positivo, los números entre dos cuadrados perfectos se ubican sobre un mismo giro de forma homogénea.

Para su construcción en Mathematica definimos la función s[n] que genera la lista de los números que se encuentran entre dos cuadrados perfectos, incluyendo el último:

s[0] = {0};
s[n_] := Range[(n - 1)^2 + 1, n^2]

s[1]
{1}

s[2]
{2,3,4}

s[5]
{17, 18, 19, 20, 21, 22, 23, 24, 25}

Definimos la función t[n] que nos genera las coordenadas de los números sobre la espiral:

t[n_] := Graphics[{Red, 
   Table[Text[
     s[n][[k]], {(2 π k/Length[s[n]] + 2 π (n - 1)) Cos[
        2 π k/Length[s[n]]], (2 π k/Length[s[n]] + 
         2 π (n - 1)) Sin[2 π k/Length[s[n]]]}], {k, 1, 
     Length[s[n]]}]}]

y la función sackst[n] que nos representa los números sobre la espiral hasta n^2,

sackst[n_] := 
 Show[PolarPlot[θ, {θ, 0, 2 n π}, Ticks -> None], 
  Table[t[j], {j, 0, n}]]

sackst[10]




Y con las funciones tp[n] y sacksp[n] vamos a dejar únicamente los números primos:

tp[n_] := 
 Graphics[{Red, 
   Table[If[PrimeQ[s[n][[k]]], 
     Text[s[n][[k]], {(2 π k/Length[s[n]] + 2 π (n - 1)) Cos[
        2 π k/Length[s[n]]], (2 π k/Length[s[n]] + 
         2 π (n - 1)) Sin[2 π k/Length[s[n]]]}]], {k, 1, 
     Length[s[n]]}]}]
sacksp[n_] := 
 Show[PolarPlot[θ, {θ, 0, 2 n π}, Ticks -> None], 
  Table[tp[j], {j, n}]]
sacksp[10]




Para mejorar la visualización y poder representar una mayor cantidad de números, pondremos un punto en el lugar que se encuentra un número primo:

p[n_] := Graphics[{Red, 
   Table[If[PrimeQ[s[n][[k]]], 
     Tooltip[Point[{(2 π k/Length[s[n]] + 2 π (n - 1)) Cos[
        2 π k/Length[s[n]]], (2 π k/Length[s[n]] + 
         2 π (n - 1)) Sin[2 π k/Length[s[n]]]}], 
      ToString[s[n][[k]]]]], {k, 1, Length[s[n]]}]}]
sacks[n_] := 
 Show[PolarPlot[θ, {θ, 0, 2 n π}, Ticks -> None], 
  Table[p[j], {j, n}]]

sacks[100]




quitando la espiral de fondo,

sacks[n_] := 
 Show[(*PolarPlot[θ,{θ,0,2n π},Ticks->None],*)
  Table[p[j], {j, n}]]

sacks[100]




se observan curvas donde tienden a organizarse un gran número de primos y otras donde no aparecen, destacamos algunas:

Alineaciones libres de números primos : 

1. Semirrecta horizontal derecha : cuadrados perfectos

2. Línea inmediatamente inferior : números de la forma n² - 1, divisibles siempre por n + 1 y n - 1

3. Semirrecta horizontal izquierda : números de la forma n² + n, divisibles siempre por n y n + 1.

Curvas aparentemente densas en números primos : 

4. Una espiral que, en la ilustración, termina cerca de la parte inferior del disco : números de la forma n² + n + 41, el polinomio descubierto por Euler.

5. Otra espiral situada 24 lugares por encima de la anterior : números de la forma n²+ n + 17

6. Línea inmediatamente superior a la semirrecta horizontal izquierda : números de la forma n² + n - 1

Para mayor información visite la página http://www.numberspiral.com


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


viernes, 7 de julio de 2017

Frase Célebre de Ernst Mach

Por extraño que parezca, la fuerza de las matemáticas 
reside en pasar por alto todos los pensamientos innecesarios 
y en la maravillosa frugalidad de las operaciones mentales.

Ernst Mach

martes, 4 de julio de 2017

Números Normales


Un número real es un Número Normal en base b si en su expansión decimal en base b los dígitos se distribuyen de una forma uniforme. Es decir, los números de una cifra aparecen en la misma proporción, los de dos cifras, los de tres cifras, etc. O la probabilidad de encontrar una secuencia dada de dígitos a lo largo de su expansión decimal es igual que si se fuera a buscar cualquier otra secuencia de la misma cantidad de dígitos. Y se dice Número Normal Absoluto si esto ocurre para toda base. Los Números Normales fueron introducidos por Émile Borel en 1909, quien demostró la existencia de los Números Normales. Pero fue Sierpinski en 1916 quien construyó el primer Número Normal Absoluto.

Veamos algunos ejemplos :

El número de Champernowne

Es el número decimal entre cero y uno cuyas cifras decimales se obtienen concatenando los enteros positivos, su nombre se debe al matemático y economista británico D. G. Champernowne que lo publicó  como estudiante en 1933. En Mathematica se cuenta con el comando ChampernowneNumber[b] donde b específica la base en la que se desea construir. Así, el Número de Champernowne en base 10 con 100 cifras decimales es:

N[ChampernowneNumber[10], 100]
0.1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253546

Contamos la aparición de cada dígito al tomar cien millones de cifras decimales:

BarChart[Apply[Labeled, 
  Reverse[Sort[Tally[RealDigits[N[ChampernowneNumber[10], 100000000]][[1]]]],2],{1}]]



vemos que el número uno tiende a aparecer aproximadamente un 40 % más que las otras cifras que si tienden a presentarse de forma uniforme.

Ahora, con los números de dos dígitos. Para esto utilizamos el comando Partition[  ,2,1] ,para cien cifras decimales:

Tally[Sort[
  Partition[RealDigits[N[ChampernowneNumber[10], 100]][[1]], 2, 1]]]
{{{0, 1}, 1}, {{0, 2}, 1}, {{0, 3}, 1}, {{0, 4}, 1}, {{0, 5}, 1}, {{1, 0}, 1}, {{1, 1}, 2}, {{1, 2}, 3}, {{1, 3}, 2}, {{1, 4}, 2}, {{1, 5}, 2}, {{1, 6}, 1}, {{1, 7}, 1}, {{1, 8}, 1}, {{1, 9}, 1}, {{2, 0}, 1}, {{2, 1}, 2}, {{2, 2}, 2}, {{2, 3}, 3}, {{2, 4}, 2}, {{2, 5}, 2}, {{2, 6}, 1}, {{2, 7}, 1}, {{2, 8}, 1}, {{2, 9}, 1}, {{3, 0}, 1}, {{3, 1}, 2}, {{3, 2}, 2}, {{3, 3}, 2}, {{3, 4}, 3}, {{3, 5}, 2}, {{3, 6}, 1}, {{3, 7}, 1}, {{3, 8}, 1}, {{3, 9}, 1}, {{4, 0}, 1}, {{4, 1}, 2}, {{4, 2}, 2}, {{4, 3}, 2}, {{4, 4}, 2}, {{4, 5}, 3}, {{4, 6}, 1}, {{4, 7}, 1}, {{4, 8}, 1}, {{4, 9}, 1}, {{5, 0}, 1}, {{5, 1}, 2}, {{5, 2}, 2}, {{5, 3}, 2}, {{5, 4}, 2}, {{5, 6}, 1}, {{6, 1}, 1}, {{6, 2}, 1}, {{6, 3}, 1}, {{6, 4}, 1}, {{6, 7}, 1}, {{7, 1}, 1}, {{7, 2}, 1}, {{7, 3}, 1}, {{7, 4}, 1}, {{7, 8}, 1}, {{8, 1}, 1}, {{8, 2}, 1}, {{8, 3}, 1}, {{8, 4}, 1}, {{8, 9}, 1}, {{9, 1}, 1}, {{9, 2}, 1}, {{9, 3}, 1}, {{9, 4}, 1}, {{9, 5}, 1}}

Para diez millones de cifras decimales:

BarChart[Apply[Framed, 
  Reverse[Tally[
    Sort[Partition[
      RealDigits[N[ChampernowneNumber[10], 10000000]][[1]], 2, 1]]], 
   2], {2}]]



Observamos que existen números de dos cifras que aparecen más que los otros.

Veamos los números de tres cifras, primeras cien cifras decimales:

Tally[Sort[
  Partition[RealDigits[N[ChampernowneNumber[10], 100]][[1]], 3, 1]]]
{{{0, 1, 1}, 1}, {{0, 2, 1}, 1}, {{0, 3, 1}, 1}, {{0, 4, 1}, 1}, {{0, 5, 1}, 1}, {{1, 0, 1}, 1}, {{1, 1, 1}, 1}, {{1, 1, 2}, 1}, 
{{1, 2, 1}, 1}, {{1, 2, 2}, 1}, {{1, 2, 3}, 1}, {{1, 3, 1}, 1}, 
{{1, 3, 2}, 1}, {{1, 4, 1}, 1}, {{1, 4, 2}, 1}, {{1, 5, 1}, 1}, 
{{1, 5, 2}, 1}, {{1, 6, 1}, 1}, {{1, 7, 1}, 1}, {{1, 8, 1}, 1}, 
{{1, 9, 2}, 1}, {{2, 0, 2}, 1}, {{2, 1, 2}, 1}, {{2, 1, 3}, 1}, 
{{2, 2, 2}, 1}, {{2, 2, 3}, 1}, {{2, 3, 2}, 1}, {{2, 3, 3}, 1}, 
{{2, 3, 4}, 1}, {{2, 4, 2}, 1}, {{2, 4, 3}, 1}, {{2, 5, 2}, 1}, 
{{2, 5, 3}, 1}, {{2, 6, 2}, 1}, {{2, 7, 2}, 1}, {{2, 8, 2}, 1}, 
{{2, 9, 3}, 1}, {{3, 0, 3}, 1}, {{3, 1, 3}, 1}, {{3, 1, 4}, 1}, 
{{3, 2, 3}, 1}, {{3, 2, 4}, 1}, {{3, 3, 3}, 1}, {{3, 3, 4}, 1}, 
{{3, 4, 3}, 1}, {{3, 4, 4}, 1}, {{3, 4, 5}, 1}, {{3, 5, 3}, 1}, 
{{3, 5, 4}, 1}, {{3, 6, 3}, 1}, {{3, 7, 3}, 1}, {{3, 8, 3}, 1}, 
{{3, 9, 4}, 1}, {{4, 0, 4}, 1}, {{4, 1, 4}, 1}, {{4, 1, 5}, 1}, 
{{4, 2, 4}, 1}, {{4, 2, 5}, 1}, {{4, 3, 4}, 1}, {{4, 3, 5}, 1},
{{4, 4, 4}, 1}, {{4, 4, 5}, 1}, {{4, 5, 4}, 1}, {{4, 5, 6}, 1}, 
{{4, 6, 4}, 1}, {{4, 7, 4}, 1}, {{4, 8, 4}, 1}, {{4, 9, 5}, 1}, 
{{5, 0, 5}, 1}, {{5, 1, 5}, 1}, {{5, 1, 6}, 1}, {{5, 2, 5}, 1}, 
{{5, 2, 6}, 1}, {{5, 3, 5}, 1}, {{5, 3, 6}, 1}, {{5, 4, 5}, 1}, 
{{5, 4, 6}, 1}, {{5, 6, 7}, 1}, {{6, 1, 7}, 1}, {{6, 2, 7}, 1}, 
{{6, 3, 7}, 1}, {{6, 4, 7}, 1}, {{6, 7, 8}, 1}, {{7, 1, 8}, 1}, 
{{7, 2, 8}, 1}, {{7, 3, 8}, 1}, {{7, 4, 8}, 1}, {{7, 8, 9}, 1}, 
{{8, 1, 9}, 1}, {{8, 2, 9}, 1}, {{8, 3, 9}, 1}, {{8, 4, 9}, 1}, 
{{8, 9, 1}, 1}, {{9, 1, 0}, 1}, {{9, 2, 0}, 1}, {{9, 3, 0}, 1}, 
{{9, 4, 0}, 1}, {{9, 5, 0}, 1}}

Para las primeros diez millones de cifras decimales :

BarChart[Apply[Framed, 
  Reverse[Tally[
    Sort[Partition[
      RealDigits[N[ChampernowneNumber[10], 10000000]][[1]], 3, 1]]], 
   2], {2}]]



Observamos lo mismo que para los números de dos cifras, existen algunos que aparecen un número mayor de veces. Lo sorprendente es que pese a esta evidencia computacional en contra se ha demostrado que el Número de Champernowne es Normal en base 10.

El número de Copeland - Erdös

Es el número decimal entre cero y uno cuyas cifras decimales se obtienen concatenando los números primos. Construyamos el Número de Copeland-Erdös hasta el décimo número primo.

cop = Flatten[Prepend[IntegerDigits[Table[Prime[n], {n, 10}]], 0]];
N[FromDigits[{cop, 1}], Length[cop] - 1]

0.2357111317192329

Veamos el número de veces que aparece cada dígito al tomar el primer millón de números primos en su conformación:

BarChart[Apply[Labeled, 
  Reverse[Sort[
    Tally[Flatten[
      Prepend[IntegerDigits[Table[Prime[n], {n, 1000000}]], 0]]]], 
   2], {1}]]



El dígito uno tiende a aparecer más que los otros dígitos, seguido por el tres, siete y nueve y posteriormente los demás de forma uniforme.

Para los números de dos cifras:

BarChart[Apply[Framed, 
  Reverse[Sort[
    Tally[Partition[
      Flatten[IntegerDigits[Table[Prime[n], {n, 1000000}]]], 2, 1]]], 
   2], {2}]]



Y de tres cifras :

BarChart[Apply[Framed, 
  Reverse[Sort[
    Tally[Partition[
      Flatten[IntegerDigits[Table[Prime[n], {n, 1000000}]]], 3, 1]]], 
   2], {2}]]



Al igual que en el Número de Champernowne, pese a toda la evidencia computacional, en 1946 se demostró que es un Número Normal en base 10, por Arthur Herbert Copeland y Paul Erdös, de ahí su nombre.

La constante Pi

El número más importante de la geometría, que se obtiene como la razón entre el perímetro de una circunferencia y su diámetro. Se sabe que es irracional, trascendente, pero se desconoce si es un Número Normal, se conjetura que sí lo es.

Cómo se distribuye la aparición de cada uno de los dígitos en el primer millón de cifras decimales de Pi.

BarChart[Apply[Labeled, 
  Reverse[Sort[Tally[RealDigits[N[Pi, 1000000]][[1]]]], 2], {1}]]



Los números de dos cifras también en el primer millón de cifras decimales.

BarChart[Apply[Framed, 
  Reverse[Sort[
    Tally[Partition[RealDigits[N[Pi, 1000000]][[1]], 2, 1]]], 
   2], {2}]]


Los números de tres cifras en el primer millón de cifras decimales de Pi.

BarChart[Apply[Framed, 
  Reverse[Sort[
    Tally[Partition[RealDigits[N[Pi, 1000000]][[1]], 3, 1]]], 
   2], {2}]]



Del número Pi se tiene toda la evidencia computacional de ser un Número Normal en base 10, pero no se tiene aún una demostración formal de este hecho.

Como se ha mencionado varias veces a lo largo del Blog, las pruebas computacionales son evidencias de un hecho pero no son concluyentes para afirmar, únicamente para negar (como  contraejemplo).

En demonstrations.wolfram.com se pueden encontrar desarrollos hechos por los usuarios de Mathematica, allí tengo algunos aportes entre los que quiero destacar ahora http://demonstrations.wolfram.com/FindingStringsOfDigitsInTheDecimalDigitsOfFamousNumbers/ donde podemos cualquier número buscarlo entre las cifras decimales de los más importantes números irracionales.

Ejercicio

1. Al tomar un millón de números primos para la conformación del Número de Copeland - Erdös, cuántas cifras decimales tiene el número?

2. Realizar el estudio computacional de la aparición de los números de cuatro cifras en la constante Pi.

3. Realizar el estudio computacional de la Normalidad de los números e (la constante de Euler) y \[Phi] (el número áureo).


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