Entrada destacada

Distancia media de dos puntos en un cuadrado unitario

martes, 31 de octubre de 2017

Números expresables como la suma de tres cuadrados


Si un número no es de la forma 4^n (8m+7) entonces es suma de tres cuadrados

Realizaremos el estudio numérico hasta el primer millón de enteros positivos.

Buscamos hasta el millón los números que son de la forma 4^n (8m+7). Como 4^9 < 1000000 < 4^10, n tomará valores entre 0 y 9, y puesto que 1000000/8=125000, m tomará valores entre 0 y 125000. Estos números se los restamos, de forma conjuntista, a los enteros hasta un millón para determinar los números que NO cumplen ser de la forma 4^n (8m+7).

aaa = Complement[Range[1000000], 
  Flatten@Table[4^n (8 m + 7), {n, 0, 9}, {m, 0, 125000}]]




Ahora, construimos todos los números que son suma de tres cuadrados

bbb = Sort@
  DeleteDuplicates@
   Flatten@Table[a^2 + b^2 + c^2, {a, 0, 1000}, {b, 0, a}, {c, 0, b}]



Seleccionamos los menores a un millón

ccc = Select[bbb, 0 < # <= 1000000 &]



Comparamos los dos conjuntos

Complement[aaa, ccc]
{}

Complement[ccc,aaa]
{}

Por tanto los dos conjuntos son iguales, así :

Si un número no es de la forma 4^n (8m+7) entonces es suma de tres cuadrados.



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


martes, 24 de octubre de 2017

Caracol de Pascal


Dada la circunferencia unitaria (de radio una unidad y centrada en el origen), consideramos las rectas que pasan por el punto (-1,0), marcamos el punto donde la recta corta la circunferencia y lo llamamos P.

La circunferencia la vamos a considerar de forma paramétrica como los puntos (Cos[t],Sin[t]) y así para un valor t la recta tiene por ecuación:

y = (Sin[t]/(Cos[t] + 1)) (x + 1)

así, podemos generar la siguiente representación :

Manipulate[
 Show[ParametricPlot[{Cos[t], Sin[t]}, {t, 0, 2 Pi}, 
   PlotStyle -> Dashed, PlotRange -> 3], 
  Plot[(Sin[a]/(Cos[a] + 1)) (x + 1), {x, -2.5, 2.5}], 
  Graphics[{PointSize[Large], Point[{Cos[a], Sin[a]}]}], 
  Graphics[Text["P", {Cos[a + 0.2], 
     Sin[a + 0.2]}]]], {{a, Pi/2}, 0, 2 Pi}]




Ahora, consideraremos todos los puntos sobre la recta que se encuentran a una distancia igual a a unidades del punto P, para ello resolvemos la ecuación:


o equivalentemente,

(x - Cos[t])² + ((Sin[t]/(Cos[t] + 1)) (x + 1) - Sin[t])² = a²

por medio del comando Solve[ ] tenemos,

Solve[(x - Cos[t])^2 + ((Sin[t]/(Cos[t] + 1)) (x + 1) - Sin[t])^2 ==  a^2, x]

{{x -> -a Cos[t/2] + Cos[t]}, {x -> a Cos[t/2] + Cos[t]}}

Representando las soluciones de forma paramétrica, tenemos:

Manipulate[
 ParametricPlot[{{-a Cos[t/2] + Cos[t], 
    Sin[t]/(Cos[t] + 1) (-a Cos[t/2] + Cos[t] + 1)}, {a Cos[t/2] + 
     Cos[t], Sin[t]/(Cos[t] + 1) (a Cos[t/2] + Cos[t] + 1)}}, {t, 0, 
   2 \[Pi]}, PlotRange -> 5], {{a, 2}, 0, 4}]


Esta figura se conoce como un Caracol de Pascal, para a=0 es la circunferencia unitaria y hasta a=2 tiene el bucle interior. Representándolo junto con la circunferencia y la recta que lo genera, obtenemos:

Manipulate[
 Show[ParametricPlot[{{-a Cos[t/2] + Cos[t], 
     Sin[t]/(Cos[t] + 1) (-a Cos[t/2] + Cos[t] + 1)}, {a Cos[t/2] + 
      Cos[t], Sin[t]/(Cos[t] + 1) (a Cos[t/2] + Cos[t] + 
        1)}}, {t, \[Pi]/2,θ}, PlotRange -> 5, 
   PlotStyle -> Red], 
  ParametricPlot[{Cos[p], Sin[p]}, {p, 0, 2 Pi}, 
   PlotStyle -> Dashed], 
  Plot[(Sin[θ]/(Cos[θ] + 1)) (x + 1), {x, -2.5, 
    2.5}]], {θ, Pi/2 + 0.00001, Pi/2 + 2 Pi}, {{a, 2},
   0, 4}]





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


viernes, 20 de octubre de 2017

Frase Célebre de Isaac Asimov

Examinen fragmentos de pseudociencia 
y encontrarán un manto de protección, 
un pulgar que chupar, unas faldas a las que agarrarse. 

Y, ¿qué ofrecemos nosotros a cambio? 
¡Incertidumbre! ¡Inseguridad!

Isaac Asimov

martes, 17 de octubre de 2017

Circunferencias de Apolonio


Creadas por Apolonio de Perge (Circa 262 a.C. - Circa 190 a.C.) cuyas obras se perdieron y aparecen únicamente menciones a sus trabajos. El problema que plantea Apolonio es: dados dos puntos fijos en el plano A y B, y r > 0 deseamos determinar todos los puntos P del plano tal que:



Aquí nos preguntamos por la división de las distancias desde A y B al punto P, si nos preguntamos por la suma la solución son elipses y por la resta son hipérbolas.

Para facilitar la representación vamos a suponer que : A (-a, 0), B (a, 0) y P (x, y), esto para a > 0, por tanto :






Manipulando los valores de a y r, tenemos :

Manipulate[
 Show[ContourPlot[
   a^2 + 2 a x + x^2 + y^2 == r^2 (a^2 - 2 a x + x^2 + y^2), {x, -5, 
    5}, {y, -5, 5}, Axes -> True], Graphics[{Red, Point[{-a, 0}]}], 
  Graphics[{Green, Point[{a, 0}]}]], {{a, 1}, 0, 3}, {{r, 0.5}, 
  0.0001, 5}]




Manipulando a para valores de r = 0.2, 0.4, 0.6, 0.8, 1, 5, 2.5, 1.66, 1.25

Manipulate[
 Show[Table[
   ContourPlot[
    a^2 + 2 a x + x^2 + y^2 == r^2 (a^2 - 2 a x + x^2 + y^2), 
{x, -5, 5}, {y, -5, 5}, Axes -> True], {r, {0.2, 0.4, 0.6, 0.8, 1, 5, 2.5, 1.66, 1.25}}], 
  Graphics[{Red, Point[{-a, 0}]}], 
  Graphics[{Green, Point[{a, 0}]}]], {{a, 1}, 0, 3}]



Ahora, vamos a determinar  la ecuación de las circunferencias que pasan por los puntos A(-a,0) y B(a,0), buscamos el centro (h, k) y el radio R tal que satisfaga :



donde obtenemos el sistema de ecuaciones :



Igualando por R², tenemos:


Clear[a]
Solve[{(a + h)^2 + k^2 == R^2, (a - h)^2 + k^2 == R^2}, {h, R}]





Tomando el valor de R > 0, obtenemos una familia de circunferencias que son ortogonales a las circunferencias de Apolonio.

Manipulate[
 Show[Table[
   ContourPlot[
    a^2 + 2 a x + x^2 + y^2 == r^2 (a^2 - 2 a x + x^2 + y^2), 
{x, -5, 5}, {y, -5, 5}], {r, {0.2, 0.4, 0.6, 0.8, 1, 5, 2.5, 1.66, 
     1.25}}], 
  Table[Graphics[{Red, Circle[{0, k}, Sqrt[a^2 + k^2]]}], {k, -4, 
    4}]], {{a, 1}, 0, 3}]




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


viernes, 13 de octubre de 2017

martes, 10 de octubre de 2017

Círculos de Ford



Son círculos centrados en (p/q,1/2q²) y con radio 1/2q², donde p/q es una fracción irreducible, es decir, p y q son números enteros primos entre sí. Estos círculos se notan por C[p/q], y la fracción p/q se conoce como la fracción generatriz del círculo.

Los círculos de Ford reciben el nombre del matemático estadounidense Lester R. Ford quien los describió en un artículo en 1938.

Manipulate[
 Show@Table[
   Graphics[
    If[CoprimeQ[p, q], Tooltip@Circle[{p/q, 1/(2 q^2)}, 1/(2 q^2)]], 
    Axes -> True, PlotRange -> {{-0.5, 1.5}, {0, 1}}], {q, 1, n}, {p, 0, q}], {n, 1, 10, 1}]




Suma de las Área de los Círculos de Ford

La suma del área de todos los círculos de Ford, está dada por:


donde (p, q) es el máximo común divisor, (p, q) = 1 indica que son primos relativos. Simplificando, obtenemos :







0.872284

Propiedad

marcas = {DeleteDuplicates@
     Sort@Flatten[Table[{p/q, p/q}, {q, 1, 4}, {p, 0, q}], 1], 
    None} /. {{0, 0} -> {0, "⁰/₁"}, {1, 1} -> {1, "¹/₁"}};
Show@Table[
  Graphics[If[CoprimeQ[p, q], Circle[{p/q, 1/(2 q^2)}, 1/(2 q^2)]], 
   Axes -> True, Ticks -> marcas, 
   PlotRange -> {{-0.5, 1.5}, {0, 1}}], {q, 1, 4}, {p, 0, q}]



Veamos que si tomamos tres círculos de Ford tangentes consecutivos, en orden: C[a/b], C[m/n] y C[c/d], se cumple:

donde



La sucesión de las fracciones generatrices de los Círculos de Ford se conoce como la Sucesión de Farey.


Cómo se creó el Gif del Manipulate

Export[NotebookDirectory[] <> "fordcirculo.gif", 
 Manipulate[
  Show@Table[
    Graphics[Tooltip@Circle[{p/q, 1/(2 q^2)}, 1/(2 q^2)], 
     Axes -> True, PlotRange -> {{-0.5, 1.5}, {0, 1}}], {q, 1, n}, {p, 0, q}], {n, 1, 10, 1}], "AnimationRepetitions" -> Infinity]

Lo crea en la misma carpeta en la que se encuentra el archivo.



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


viernes, 6 de octubre de 2017

martes, 3 de octubre de 2017

Gráficas Similares de Ecuaciones



Vamos a resolver el sistema de ecuaciones :



Con la ayuda del comando ContourPlot[ ] graficamos ambas ecuaciones en el plano:

g1 = ContourPlot[x^2/25 + y^2/16 == 1, {x, -5, 5}, {y, -5, 5}]


g2 = ContourPlot[x^2 + y^2 == (x^2/5 + y^2/4)^2, {x,-5,5},{y,-5, 5}]



Para verlas juntas en mismo plano:

Show[g1,g2]


Observamos que ambas ecuaciones corresponden al mismo lugar geométrico.

Pero al resolver por el comando Solve[ ] y graficar, tenemos:

sol = {x, y} /. 
  Solve[{x^2/25 + y^2/16 == 1, x^2 + y^2 == (x^2/5 + y^2/4)^2}, {x, y}]
g3 = Graphics[{Red, PointSize[Large], Point[sol]}];
Show[g1, g2, g3]

{{-5, 0}, {0, -4}, {0, 4}, {5, 0}}



Las ecuaciones solo coinciden en cuatro puntos, los señalados en rojo.

Al graficar el primer cuadrante con amabas ecuaciones vemos que NO coinciden

ContourPlot[{x^2/25 + y^2/16 == 1, 
  x^2 + y^2 == (x^2/5 + y^2/4)^2}, {x, 0, 5}, {y, 0, 5}, 
 ContourStyle -> {Green, Red}]


Al despejar x² en (1) y reemplazarlo en (2) obtenemos:


x^2 + y^2 == (x^2/5 + y^2/4)^2 /. x^2 -> (1 - y^2/16) 25




Simplify[%]
y³ == 16 y


Solve[y³ == 16 y, y]
{{y -> -4}, {y -> 0}, {y -> 4}}

Las segundas componentes de las soluciones que encontramos anteriormente.

Veamos numéricamente que tan diferentes son las curvas en el primer cuadrante:

Solve[x^2/25 + y^2/16 == 1, y]





Tomamos la segunda solución por ser la positiva.

Solve[x^2 + y^2 == (x^2/5 + y^2/4)^2, y]







Tomamos la segunda solución por ser la positiva y real, pues la cuarta da números complejos.

Realizando una tabla de valores, tenemos:











Obtenemos diferencia de 0 en los valores de x=0 y x=4, que son las soluciones que ya se habían encontrado.


El área entre las dos curvas es:







0.0978699

y el área de la curva mayor,







15.8058

comparando la diferencia de área entre las curvas con el área mayor obtenemos,

a1/a2

0.00619201

que corresponde a una diferencia en el área de 0.62%.

Así, la vista nos engaño al creer que las dos ecuaciones correspondían al mismo lugar geométrico.


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