Frase Célebre de Arnold Sommerfeld

Las matemáticas son como las enfermedades infantiles:
cuanto antes se "contraigan", mejor.

Arnold Sommerfeld

Primo Morada

Descargar como Notebook

Dado un número entero n mayor que 1. Se listan todos sus factores primos en orden ascendente, incluyendo los factores repetidos, este producto se concatena obteniendo un nuevo número. Al número obtenido se le realiza el mismo procedimiento hasta obtener un número primo, este se denomina el primo morada del número inicial pm(n).

Por ejemplo, si n = 14, sus factores primos ordenados son (2,7) y obtendríamos el número 27. Sus factores primos son (3,3,3) y conseguiríamos así el número 333. Los factores primos de 333 son (3,3,37), y lograríamos el número 3337. El anterior número factoriza en (47,71), obteniendo al concatenarlos 4771, que es el producto de los primos 13 y 367. Y 13367 es primo, con lo cual habríamos terminado. Así pm(14)=13367. En resumen,

pm (14) = pm (27) = pm (333) = pm (3337) = pm (4771) = pm (13367) = 13367

también, si n es primo se tiene que pm (n) = n .

En Mathematica

Primero, se define la función pm[ ] que dado un número genera la concatenación de sus factores primos:

vv[aa_] := IntegerDigits@Table[aa[[1]], {i, aa[[2]]}]

pm[n_] := FromDigits@Flatten@Map[vv, FactorInteger[n]]

Aplicado al número 14 tenemos :

FactorInteger[14]

{{2, 1}, {7, 1}}

Aparecen, 2 una vez por 7 una vez,

pm[14]

27

Es importante que tenga presente también factores primos de más de una cifra:

FactorInteger[333]

{{3, 2}, {37, 1}}

Aparecen, 3 dos veces y 37 una vez,

pm[333]

3337

Ahora, se define la función pmlist[ ] que genera la lista del proceso hasta conseguir el Primo Morada,

pmlist[n_] := NestWhileList[pm, n, CompositeQ[#] &]

Aplicado al 14, tenemos :

pmlist[14]

{14, 27, 333, 3337, 4771, 13367}

Aplicando la función pmlist[ ] a los enteros de 2 a 10 :

Table[{n, pmlist[n]}, {n, 2, 10}] // TableForm

Definimos la función pmorada[ ] que nos muestra el número de elementos en pmlist[ ] y el Primo Morada,

pmorada[n_] := 

 Module[{lista}, lista = pmlist[n]; {Length[lista], Last[lista]}]

TableForm[Table[Flatten[{n, pmorada[n]}], {n, 2, 48}], 

 TableHeadings -> {None, {"Número", "Iteraciones", "Primo Morada"}}]

Conjetura

Para el número 49 no se ha podido establecer si este proceso tiene un fin, es decir si en algún momento se alcanza un número primo.

pmlistr[n_] := NestWhileList[pm, n, CompositeQ[#] &, 50, 30]

pmlistr[49]

{49, 77, 711, 3379, 31109, 132393, 344131, 1731653, 71143523, 11115771019, 31135742029, 717261644891, 11193431873899, 116134799345907, 3204751189066719, 31068250396355573, 

62161149980213343, 336906794442245927, 734615161567701999, 31318836286194043641, 333431436916146111627309, 33205716184556772142207827, 31367222155734752971376323127, 

733915126325777821480557336017, 476734743112036198712947236602187, 

377171280957470909577133234490256751, 3096049809383121823389214993262890297, 

73796236325118712936424989555929478399, 13118114526141133089538087518197265265053, 

319521441731977174163487542111577539726749, 595415617656474189392601483764603009147911}

Primeros 30 números para 49 y no se encuentra el Primo Morada.

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

Frase Célebre de Israel Gelfand

La gente piensa que ellos no entienden la matemáticas, 
pero todo se trata de la forma en que se las explique.

Si a un tomador le pregunta que es mayor, 2/3 o 3/5, 
él seguramente no sabrá.
Pero si le cambia la pregunta por:
Qué es mejor, 2 botellas de vodka para 3 personas,
o 3 botellas de vodka para 5 personas?
Él seguramente va a decir que 2 botellas para 3 personas.

Israel Gelfand

Introducción a los Límites

Descargar como Notebook

Ejemplo 1

Dada la función

sabemos que su dominio son los reales excepto x = 2, si necesitamos re definir la función para que tenga un valor "adecuado" en 2, veamos como se comporta en los valores cercanos:

TableForm[Table[{x, (x^2 - 4)/(x - 2)}, {x, 1.9, 2.1, 0.05}], 

 TableHeadings -> {None, {"x", "f(x)"}}]

Más cercanos :

TableForm[Table[{x, (x^2 - 4)/(x - 2)}, {x, 1.95, 2.05, 0.01}], 

 TableHeadings -> {None, {"x", "f(x)"}}]

Aún más cercanos :

TableForm[Table[{x, (x^2 - 4)/(x - 2)}, {x, 1.99, 2.01, 0.001}], 

 TableHeadings -> {None, {"x", "f(x)"}}]

Podemos conjeturar que el valor más adecuado para redefinir la función f(x) en x = 2 es 4. Por tanto:

Ahora, vamos a pensar al contrario :

De alguna forma conjeturamos (suponemos) que el valor más adecuado para redefinir la función en x=2 es 4, pero no estamos seguros, entonces vamos a ver sí cada vez que consideremos valores más cercanos a 4 en el eje Y siempre estos valores corresponden a valores más cercanos a 2 en el eje X.

Esto lo logramos considerando un intervalo en el eje Y: (4 - ∈, 4 + ∈ ), y proyectando este intervalo sobre el eje X, utilizando la función f(x) para reflejarlo, obtenemos un intervalo abierto que contiene al punto 2.

Si tomamos un valor cualquiera del intervalo sobre el eje X, diferente de 2, y lo calculamos en la función, sí cae dentro del intervalo en el eje Y podemos asegurar que 4 es el valor ideal para redefinir f(x) en x = 2.

Manipulate[t = RandomReal[]; 

 Show[Plot[(x^2 - 4)/(x - 2), {x, 0, 5}, Axes -> True, 

   AxesOrigin -> {0, 0}, AspectRatio -> 1, 

   PlotRange -> {{0, 5}, {0, 5}}], 

  Graphics[{{Black, PointSize[0.02], Point[{2, 4}]}, {White, 

     PointSize[0.01], Point[{2, 4}]}, {Dashed, Red, 

     Line[{{2, 0}, {2, 4}, {0, 4}}]}, {Pink, Opacity[0.5], 

     Polygon[{{0, 4 + e}, {0, 4 - e}, {2 - e, 4 - e}, {2 - e, 

        0}, {2 + e, 0}, {2 + e, 4 + e}, {0, 4 + e}}]}, {Blue, 

     Thickness[0.02], Line[{{0, 4 + e}, {0, 4 - e}}]}, {Green, 

     Thickness[0.02], 

     Line[{{2 - e, 0}, {2 + e, 0}}]}, {Text[

      "f(x) = (x^2-4)/(x-2)", {3.2, 4.7}]}, {Text["4 + ∈", {0.2, 4 + e}],

      Text["4 - ∈", {0.2, 4 - e}], Text[2 + e, {2.2 + e, 0.1}],

      Text[2 - e, {1.8 - e, 0.1}]}, {Dashed, Green, 

     If[ver, Line[{{2 - e + 2 e t, 0}, {2 - e + 2 e t, 

         4 - e + 2 e t}, {0, 4 - e + 2 e t}}]]}}]], {{e, 0.5, 

   "Epsilon: ∈"}, 1, 

  0.05}, {{ver, False, "Verificación"}, {False, True}}]

Ejemplo 2

La función

tiene por dominio

FunctionDomain[(3 - Sqrt[x^2 + 5])/(x^2 - 5 x + 6), x]

x < 2 || 2 < x < 3 || x > 3

los números reales excepto 2 y 3. Analizaremos primero que pasa en x=2.

Para x = 2:

Consideremos la tabla de valores,

TableForm[

 Table[{x, (3 - Sqrt[x^2 + 5])/(x^2 - 5 x + 6)}, {x, 1.99, 2.01, 

   0.001}], TableHeadings -> {None, {"x", "f(x)"}}]

observamos que el mejor valor posible para la función en x = 2 corresponde a 0.6666 = 2/3. Verifiquemos:

Manipulate[t = RandomReal[]; 

 aa = p /. 

   NSolve[(3 - Sqrt[p^2 + 5])/(p^2 - 5 p + 6) == 2/3 - e, p][[1]]; 

 bb = p /. 

   NSolve[(3 - Sqrt[p^2 + 5])/(p^2 - 5 p + 6) == 2/3 + e, p][[1]];

 cc = bb (1 - 2 t) + 4 t;

 Show[Plot[(3 - Sqrt[x^2 + 5])/(x^2 - 5 x + 6), {x, 0, 3}, 

   Axes -> True, AxesOrigin -> {0, 0}, AspectRatio -> 1, 

   PlotRange -> {{0, 4}, {0, 3}}], 

  Graphics[{{Black, PointSize[0.02], Point[{2, 2/3}]}, {White, 

     PointSize[0.01], Point[{2, 2/3}]}, {Dashed, Red, 

     Line[{{2, 0}, {2, 2/3}, {0, 2/3}}]}, {Pink, Opacity[0.5], 

     Polygon[{{0, 0.666 + e}, {0, 0.666 - e}, {aa, 0.666 - e}, {aa, 

        0}, {bb, 0}, {bb, 0.666 + e}, {0, 0.666 + e}}]}, {Blue, 

     Thickness[0.02], Line[{{0, 0.666 + e}, {0, 0.666 - e}}]}, {Green,

      Thickness[0.02], 

     Line[{{4 - bb, 0}, {bb, 0}}]}, {Text[

      "f(x) = (3-Sqrt[x^2+5])/(x^2-5x+6)", {3.4, 

       2.7}]}, {Text["2/3 + ∈", {0.2, 0.66 + e}], 

     Text["2/3 - ∈", {0.2, 0.66 - e}], 

     Text[bb, {bb + 0.2, 0.1}], 

     Text[4 - bb, {3.8 - bb, 0.1}]}, {Dashed, Green, 

     If[ver, Line[{{cc, 

         0}, {cc, (cc + 

            2)/((3 - cc) (3 + Sqrt[cc^2 + 5]))}, {0, (cc + 

            2)/((3 - cc) (3 + Sqrt[cc^2 + 5]))}}]]}}]], {{e, 0.5, 

   "Epsilon: ∈"}, 1, 

  0.05}, {{ver, False, "Verificación"}, {False, True}}]

El intervalo que se genera en el eje X tiene como centro a 2, y desde allí es que se toman los valores que al aplicarles la función caen dentro del intervalo con centro en 2/3 y radio ∈.

Para x = 3:

Consideremos la tabla

TableForm[

 Table[{x, (3 - Sqrt[x^2 + 5])/(x^2 - 5 x + 6)}, {x, 2.99, 3.01, 

   0.001}], TableHeadings -> {None, {"x", "f(x)"}}]

vemos que no existe un valor probable que se adecue para redefinir f(x) en x = 3.

Supongamos que asumimos que el valor probable sea 741

gra1 = Plot[(3 - Sqrt[x^2 + 5])/(x^2 - 5 x + 6), {x, 2, 4}, 

   Axes -> True, AspectRatio -> 1, 

   PlotRange -> {{2.9, 3.1}, {-1000, 1000}}];

Manipulate[

 Show[gra1, 

  Graphics[{{Dashed, Red, Line[{{3, 0}, {3, 741}, {0, 741}}]}, {Pink, 

     Opacity[0.5], 

     Polygon[{{0, 741 + e}, {0, 741 - e}, {2.998, 741 - e}, {2.998, 

        0}, {3, 0}, {3, 741 + e}, {0, 741 + e}}]}, {Blue, 

     Thickness[0.02], Line[{{0, 741 + e}, {0, 741 - e}}]}, {Green, 

     Thickness[0.02], 

     Line[{{2.999, 0}, {3.001, 0}}]}, {Text[

      "f(x) =(3-Sqrt[x^2+5])/(x^2-5x+6)", {3.05, 

       850}]}, {Text["741 + ∈", {3.9, 741 + e}], 

     Text["741 - ∈", {3.9, 741 - e}], 

     Text[bb, {bb + 0.2, 0.1}], 

     Text[4 - bb, {3.8 - bb, 0.1}]}, {Dashed, Green, 

     If[ver, {Line[{{2.999, 0}, {2.999, 741}, {0, 741}}], 

       Line[{{3.001, 0}, {3.001, -741}, {0, -741}}]}]}}]], {{e, 20, 

   "Epsilon: ∈"}, 50, 

  10}, {{ver, False, "Verificación"}, {False, True}}]

Si en el intervalo verde alrededor de x = 3, tomamos valores al lado izquierdo caen dentro del intervalo (741 - ∈,741 + ∈), pero si los tomamos del lado derecho caen cerca a -741.

Ejemplo 3.

Consideraremos ahora la función definida de forma seccional :

El dominio de f(x) es el intervalo cerrado [0,4], pero por la forma en que se definió es necesario analizar lo que ocurre en x = 2.

Definimos y graficamos f(x):

f[x_] := Piecewise[{{x, 0 < x < 2}, {x^2, 2 <= x < 4}}, None]

Plot[f[x], {x, 0, 4}]

Una tabla de valores cercanos a x = 2 :

TableForm[Table[{x, f[x]}, {x, 1.9, 2.1, 0.01}], 

 TableHeadings -> {None, {"x", "f(x)"}}]

Aquí, tenemos que f (2) = 4, pero qué ocurre cerca de 4 en el eje Y.

Manipulate[t = RandomReal[]; cc = 2 (1 - t) + t Sqrt[4 + e];

 dd = 2 + (2 - Sqrt[4 + e]) t; 

 Show[Plot[f[x], {x, 0, 3}, Axes -> True, AxesOrigin -> {0, 0}, 

   AspectRatio -> 1, PlotRange -> {{0, 3}, {0, 6}}], 

  Graphics[{{Black, PointSize[0.02], Point[{2, 4}]}, {Dashed, Red, 

     Line[{{2, 0}, {2, 4}, {0, 4}}]}, {Pink, Opacity[0.5], 

     Polygon[{{0, 4 + e}, {0, 4}, {2, 4}, {2, 0}, {Sqrt[4 + e], 

        0}, {Sqrt[4 + e], 4 + e}, {0, 4 + e}}]}, {Blue, 

     Thickness[0.02], Line[{{0, 4 + e}, {0, 4 - e}}]}, {Green, 

     Thickness[0.02], 

     Line[{{4 - Sqrt[4 + e], 0}, {Sqrt[4 + e], 0}}]}, {Text[

      "f(x)", {2.5, 5.7}]}, {Text["4 + ∈", {0.2, 4 + e}], 

     Text["4 - ∈", {0.2, 4 - e}], 

     Text[Sqrt[4 + e], {Sqrt[5 + e], 0.1}], 

     Text[4 - Sqrt[4 + e], {3.8 - Sqrt[4 + e], 0.1}]}, {Dashed, Green,

      If[ver, Line[{{cc, 0}, {cc, cc^2}, {0, cc^2}}], 

      Line[{{dd, 0}, {dd, dd}, {0, dd}}]]}}]], {{e, 0.5, 

   "Epsilon: ∈"}, 1, 

  0.05}, {{ver, False, "Verificación"}, {False, True}}]

Vemos que para valores a la izquierda de 2, esos valores dan fuera del intervalo (4 - ∈,4 + ∈).

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