Resultado curioso con la constante de Euler

 Descargar como Notebook

La constante de Euler aparece de muchas y variadas formas en el cálculo. Pero la siguiente es una que no tengo la explicación del por qué aparece.

Consideramos números aleatorios entre 0 y 1, nos interesa el número necesario para que la suma supere a uno. 

Por ejemplo, consideremos seis números aleatorios entre 0 y 1,

tabla = Table[RandomReal[], {6}]

{0.331578, 0.229754, 0.580864, 0.346653, 0.90035, 0.917802}

La suma acumulada de los tres primeros ya supera la unidad, entonces nos quedamos con el número 3,

Accumulate[tabla]

{0.331578, 0.561332, 1.1422, 1.48885, 2.3892, 3.307}

Esto lo podemos conseguir así :

s = 0; n = 0; int = {};

While[s < 1, s = s + RandomReal[]; n++; AppendTo[int, n]]; Last[int]

Lo sorprendente es que sí realizamos el anterior proceso un gran número de veces y promediamos la cantidad de números necesarios para alcanzar la unidad, el resultado tiende a la Constante de Euler.

Forma 1

Realizando el proceso 100000 veces .

prom = {};

Do[s = 0; n = 0; int = {};

 While[s < 1, s = s + RandomReal[]; n++; AppendTo[int, n]];

 AppendTo[prom, Last[int]], {i, 100000}]

Mean[prom] // N

2.71592

Forma 2

Este código nos da la posibilidad de graficar los promedios.

prom = {}; num = 0;

Do[s = 0; n = 0; int = {};

 While[s < 1, s = s + RandomReal[]; n++; AppendTo[int, n]]; 

 num = num + Last[int];

 AppendTo[prom, num/i], {i, 200000}]

N[Last[prom], 10]

2.716675000

Graficando la aproximación

Show[ListPlot[prom], Plot[E, {x, 0, Length[prom]}, PlotStyle -> Red], 

 PlotRange -> {2.6, 2.8}, AxesOrigin -> {0, 2.6}]

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