Entrada destacada

Problema 2

El número 2646798 tiene la propiedad que la suma de cada uno de sus dígitos elevados al orden de su posición de izquierda a derecha da el mi...

martes, 21 de noviembre de 2017

Circunferencias en Diferentes Métricas


En matemáticas el concepto de distancia en un conjunto X se generaliza a funciones

dist: X×X→[0,∞) 

que cumplan las siguientes condiciones:

1. dist(x,y) ≥ 0
2. dist(x,y) = 0, si y sólo si, x = y
3. dist(x,y)=dist(y,x)
4. dist(x,y) ≤ dist(x,z) + dist(z,y)

Vamos a considerar tres diferentes métricas: La usual que corresponde a la métrica Euclidiana, la métrica del taxista o de Manhattan y la métrica del máximo o del tablero de ajedrez. Cada una de ellas está definida por:



estas métricas ya las tiene Mathematica predefinidas como: EuclideanDistance[ ], ManhattanDistance[ ] y ChessboardDistance[ ], respectivamente.

Ahora, vamos a representar todos los puntos del plano que se encuentran a una unidad de distancia del origen en las diferentes métricas:

euclidea[x_, y_] := EuclideanDistance[{x, y}, {0, 0}]
taxista[x_, y_] := ManhattanDistance[{x, y}, {0, 0}]
maximo[x_, y_] := ChessboardDistance[{x, y}, {0, 0}]
Manipulate[
 Show[ContourPlot[metrica[x, y] == 1, {x, -1.5, 1.5}, {y, -1.5, 1.5}, 
   Axes -> True], 
  Graphics[{Red, PointSize[Medium], 
    Which[metrica === euclidea, {Point[{Sqrt[1 - t^2], t}], 
      Line[{{0, 0}, {Sqrt[1 - t^2], t}}]}, 
     metrica === taxista, {Point[{t, 1 - t}], 
      Line[{{0, 0}, {t, 0}, {t, 1 - t}}]}, 
     metrica === maximo, {Point[{t, 1}], 
      Line[{{t, 0}, {t, 1}}]}]}]], {metrica, {euclidea, maximo, 
   taxista}}, {t, 0, 1}]






En rojo se muestra el segmento o la suma de segmentos que determinan la distancia del punto sobre la figura al origen.


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


viernes, 17 de noviembre de 2017

martes, 14 de noviembre de 2017

Conjetura de Conway sobre el ascenso a Primos



Es el quinto de cinco problemas planteados por el matemático Británico John Horton Conway (1937-  ), quien ofreció mil dolares por cada problema que se resolviera.

El problema se basa en la descomposición de un número entero positivo mayor que uno como un producto de números primos (Teorema Fundamental de la Aritmética), donde se afirma que esta descomposición es única salvo el orden, pero si ordenamos en forma creciente por las bases tenemos que si es única.

La siguiente función nos da esta descomposición, observen que si un factor primo aparece una sola vez no escribimos el exponente uno.

descom[n_] := 
 If[Not@PrimeQ[n], 
  Apply[CenterDot, 
   Apply[Superscript, FactorInteger[n] /. {a_, 1} :> a, {1}]], n]

Por ejemplo :

descom[600]
2³∙3∙5²

Eliminando los puntos de producto y "bajando" los exponentes, podemos formar el número: 23352. Este proceso lo llamaremos la operación de Conway, en Mathematica la podemos definir como:

conway[n_] := 
 ToExpression@
  StringJoin[ToString /@ Select[Flatten[FactorInteger[n]], # != 1 &]]

Aplicada a nuestro ejemplo

descom[600]
2³∙3∙5²

conway[600]
23352

Ahora, si repetimos iterativamente este proceso:

descom[23352]
2³∙ 3 ∙7 ∙139

conway[conway[600]]
2337139

nuevamente,

descom[2337139]
7 ∙29² ∙397

conway[conway[conway[600]]]
7292397

nuevamente,

descom[7292397]
3 ∙7 ∙347257

conway[conway[conway[conway[600]]]]
37347257

y calculando nuevamente la función de conway, tenemos:

conway[conway[conway[conway[conway[600]]]]]
37347257

vemos que se llega al número 37347257 como número fijo, al seguir iterando se obtiene el mismo resultado. La razón de esto es:

descom[37347257]
37347257

PrimeQ[37347257]
True

Su descomposición como producto de primos es él mismo, pues  37347257 es primo.

Conjetura sobre el ascenso a primos dice :

Si partimos de un entero mayor que uno al realizar el anterior proceso siempre terminaremos en un número primo.

Para componer iterativamente la función de conway y que nos muestre la lista de los resultados, definimos:

conwaylista[n_] := NestWhileList[conway, n, Not@PrimeQ[#] &]

por ejemplo :

conwaylista[600]
{600, 23352, 2337139, 7292397, 37347257}

otro ejemplo :

conwaylista[120]
{120, 2335, 5467, 71171}

PrimeQ[71171]
True

La longitud de la lista para los números 2 al 19 es:

Table[{n, Length@conwaylista[n]}, {n, 2, 19}]
{{2, 1}, {3, 1}, {4, 3}, {5, 1}, {6, 2}, {7, 1}, {8, 2}, {9, 5}, {10, 4}, {11, 1}, {12, 2}, {13, 1}, {14, 4}, {15, 5}, {16, 3}, 
{17, 1}, {18, 4}, {19, 1}}

graficamente,

Show[ListPlot[Table[{n, Length@conwaylista[n]}, {n, 2, 19}]], 
 AxesLabel -> {HoldForm[Entero positivo], 
   HoldForm[Número de Iteraciones]}, 
 PlotLabel -> HoldForm[Iteraciones de Conway], 
 LabelStyle -> {GrayLevel[0]}]
















Los números primos son puntos fijos de la función conway[n], por tanto la longitud de la lista es 1. Las mayores longitudes la logran los números 9 y 15 con cinco iteraciones.

El número 20, también cumple la conjetura pero necesita un número alto de iteraciones:

conway[20]
{20, 225, 3252, 223271, 297699, 399233, 715623, 3263907, 32347303, 
160720129, 1153139393, 72171972859, 736728093411, 3245576031137, 
11295052366467, 310807934835791, 1789205424940407, 31745337977379983, 1122916740775279751, 7251536377635958081, 151243563319717018007, 1121396149754176552459, 75932351114908908171459, 3655130778271255318091789, 14959341367755562901131977, 34986447122585187633710659, 1831215981937332389236978179, 313224835114543391579198264647, 476664358193926455139982941801, 3894553245992691175152795023891, 132746366910908266441840480446403, 14827188440943221883267109923487963, 
31677138752258518643179233081330519, 
3399439119019280029138988876664839207, 
1031091355507223378710949904168165523463, 
132411030792311443628391225232966966285737, 
3374773953639640292210918919998158514329541, 
18118645159964859891117187397348056124388561, 
333132143964638500160914816848585652355475611, 
4339779194757514315803243245042123341102411963, 
43467514876394875501133442699882620583081205227, 
321011894373310762051641163853311891567953317269293, 
37210435034772092714046118995294856628184376694869347, 
349828786497847697248921942850440203857761430075804817, 
33182917107436506939494287772998973909148874702313377399, 
1932412735512607965871685923338963030422770854966852116073, 
37392872225493034699309237157170878572245780852206787837181, 
412647766390833734444929769855778777948727276473907467474693, 
3263523000971344529447965690456090974370023735458141834559537, 
3101454147825427160314861186911479357122687657988115033571385847, 
321036281528336051353262347964794823559426086863047234824993347497}

esta lista no es completa, pues el último valor aún no es primo :

PrimeQ[321036281528336051353262347964794823559426086863047234824993347497]
False

Pero sí cumple la conjetura, el problema aquí es la capacidad de la maquina.

La conjetura sería falsa si se encuentra un punto fijo para la función de conway, que no sea primo o un bucle de números que se repitiera indefinidamente sin ser ninguno primo.

Recientemente James Davis, quien afirma no ser matemático, encontró dicho número: 13532385396179, no es primo pues:

PrimeQ[13532385396179]
False

su descomposición es :

descom[13532385396179]
13 ∙53² ∙3853 ∙96179

y por tanto al calcularlo en conway, tenemos :

conway[13532385396179]
13532385396179

es un punto fijo para la función de conway, y no es primo.


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


viernes, 10 de noviembre de 2017