Frase Célebre de Efim Zelmanov

Las matemáticas son un arte muy especial,
ya que además de ser hermosas son útiles.

Efim Zelmanov

Teorema de van Aubel sobre un triángulo

Descargar como Notebook

Partiendo de un triángulo, tomamos dos de sus lados, y dibujamos cuadrados apoyados en ellos y determinamos sus centros. Los segmentos que unen los centros de los cuadrados y el punto medio del otro lado del triángulo, sobre el que no se construyó cuadrado, tienen la misma longitud y forman un ángulo recto.

cuadrado[color_, a_, b_] := 
 Module[{tt = EuclideanDistance[a, b]}, {color, Opacity[0.5], 
   Rotate[{Rectangle[b, b + {tt, tt}], {Black, PointSize[Large], 
      Point[RegionCentroid@Rectangle[b, b + {tt, tt}]]}}, 
    Arg[(a - b)[[2]] + I (b - a)[[1]]] + Pi/2, b]}]
punto[a_, b_] := 
 Module[{cc = Arg[(a - b)[[1]] + I (a - b)[[2]]] + Pi/4}, 
  b + Sqrt[2] EuclideanDistance[a, b]/2 {Cos[cc], Sin[cc]}]


Manipulate[
 linea[a_, b_] := 
  ParametricPlot[punto[a, b] (1 - t) + t (p + s)/2, {t, 0, 1}, 
   PlotStyle -> {Red, Thickness[0.01]}]; 
 Show[Graphics[{{Line[{p, q, s, p}]}, cuadrado[Red, p, q], 
    cuadrado[Green, q, s], {PointSize[Large], Point[(p + s)/2]}}, 
   PlotRange -> 10], linea[p, q], linea[q, s]], {{p, {1, 1}}, 
  Locator}, {{q, {-1, 1}}, Locator}, {{s, {-1, -1}}, Locator}]

Si los cuadrados se construyen hacia la parte interior del triángulo el resultado sigue siendo válido.

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 Benjamin Peirce

La matemática es la ciencia que señala
las conclusiones necesarias.

Benjamin Peirce

El Problema del Vendedor para Colombia

Algunos problemas de optimización no presentan desarrollos clásicos basados en las herramientas que nos brinda el análisis, porque involucran demasiados procesos.  En nuestro caso 42! sería el número de estimaciones que se deberían calcular, esto  hace imposible plantear de manera manual una solución óptima a un problema real, el presente escrito muestra como esta debilidad se  soluciona cuando se incorporan herramientas computacionales  a la solución de problemas.

El problema  consiste en que dadas n ciudades se debe encontrar la ruta más corta para recorrer las n ciudades.  La solución clásica, nos permitiría encontrar la minimización de la distancia cada dos ciudades,  teniendo así que resolver el problema un número finito de veces, de manera aleatoria y sin la certeza de tener todas las posibles combinaciones.

Las primeras referencias del problema provienen de 1832 para vendedores viajeros, posteriormente fue mencionado por Karl Menger en 1930 como Shortest Hamiltonian Path”, en 1949 fue mencionado por J. B. Robinson en: “On the Hamiltonian Game ( a traveling sales problem) como  se conoce hoy en día.  En 1954 G. Dantzig, R Fulkerson y S. Johnson, presentan una aproximación de la solución como:”Solution of a large-scale travelling-salesman problem” tomando 49 ciudades capitales de los Estados Unidos,  a partir de esto el problema se ha venido desarrollando aumentando el número de ciudades: 49 (1954) , 64(1971), 67 (1975), 120(1977), 318(1980), 532( 1987), 666(1987), 2392 (1987), 7397 (1994), 13509 (1998), 15112(2001), 24978 (2004), 33810 (2005), la solución se ha dado con algoritmos de programación entera.

Nuestro aporte es resolverlo para Colombia, tomando datos reales y forjando una solución óptima para cualquier empresa que tenga este problema de logística con las rutas de sus mercancías o de sus vendedores, entre otros.  . 

Para la solución del problema se utiliza la siguiente metodología:

1.    Se determina una función de distancia entre cualquier par de ciudades,

2.    Tomando por ejemplo, el orden alfabético, se ordenan las ciudades en un conjunto {1,2,…,n}, y se consideran todas las posibles permutaciones (diferentes ordenes) de todos los elementos del conjunto.  Así existen  n factorial posibilidades.

3.    Se consideran la distancia de todas las rutas (permutaciones generadas) y se busca la mínima.

Cuando se presenta la metodología quizás se resta importancia a la solución del problema, pero si consideramos  el caso para 10 ciudades,  nos damos cuenta que el número total de permutaciones es 10!=3 628 800 y se debe en cada caso calcular 9 distancias, así el número de distancias a calcular es 32 659 200. Lo cual es una tarea que manualmente no se puede resolver, esto hace necesario cierta ayuda computacional.

Para darle la importancia requerida se resolverá el problema en un caso concreto, que involucra un análisis real a un problema típico de los comerciantes: 

Un agente viajero desea visitar las ciudades más importantes de Colombia, utilizando la ruta más corta, 

El vendedor se enfrenta  primero a escoger  que ciudades debería visitar, ¿qué  hace que una sea más importante que las otras?, el supone que sólo visitara ciudades que tengan cierto número de habitantes, y que tratará que estas formen un polígono si se mirara sobre un mapa del país.

Metodología a seguir:

1.    Determinar el criterio de importancia de las ciudades,

2.    Realizar su búsqueda,

3.    Formular la distancia entre dos de ellas,

4.    Optimizar la fórmula  de distancia.

Dentro de la herramienta el proceso que se sigue es:

1. La búsqueda de las ciudades y su ubicación: está se realiza   con el motor de cálculo de Wolframalpha,  ya que posee un repositorio de información curada (es decir, se puede confiar en ella), el criterio que se aplica para elegir  las ciudades es el número de habitantes, en este caso la ciudad debe tener más de 100 000 habitantes.

En Mathematica la búsqueda, sería de la siguiente forma:

ciudades=CityData[{Large,"Colombia"}]

2. El resultado de la búsqueda sería:

{{Bogota,DistritoCapital,Colombia},{Medellin,Antioquia,Colombia},{Cali,ValleDelCauca,Colombia},{Barranquilla,Atlantico,Colombia},{Cartagena,Bolivar,Colombia},{Cucuta,NorteDeSantander,Colombia},{Bucaramanga,Santander,Colombia},{Soledad,Atlantico,Colombia},{Ibague,Tolima,Colombia},{Soacha,Cundinamarca,Colombia},{SantaMarta,Magdalena,Colombia},{Villavicencio,Meta,Colombia},{Pereira,Risaralda,Colombia},{Manizales,Caldas,Colombia},{Bello,Antioquia,Colombia},{Valledupar,Cesar,Colombia},{Pasto,Narino,Colombia},{Buenaventura,ValleDelCauca,Colombia},{Monteria,Cordoba,Colombia},{Neiva,Huila,Colombia},{Itagui,Antioquia,Colombia},{Armenia,Quindio,Colombia},{Floridablanca,Santander,Colombia},{Popayan,Cauca,Colombia},{Palmira,ValleDelCauca,Colombia},{Sincelejo,Sucre,Colombia},{DosQuebradas,Risaralda,Colombia},{Envigado,Antioquia,Colombia},{Barrancabermeja,Santander,Colombia},{Tulua,ValleDelCauca,Colombia},{Tunja,Boyaca,Colombia},{Riohacha,LaGuajira,Colombia},{Maicao,LaGuajira,Colombia},{Girardot,Cundinamarca,Colombia},{Sogamoso,Boyaca,Colombia},{Giron,Santander,Colombia},{Florencia,Caqueta,Colombia},{Apartado,Antioquia,Colombia},{Cartago,ValleDelCauca,Colombia},{Buga,ValleDelCauca,Colombia},{Quibdo,Choco,Colombia},{Facatativa,Cundinamarca,Colombia}}

Obtenemos una lista de 42 ciudades junto con su departamento y el país, a este se le asigna el nombre de ciudades. Ahora, generamos  una lista de las coordenadas geográficas de la anterior lista (ciudades) y se llamará coordenadas, aquí obtendremos la latitud y la longitud de cada ciudad:

coordenadas = CityData[#, "Coordinates"] & /@ ciudades

{{4.63,-74.09},{6.29,-75.54},{3.44,-76.52},{10.96,-74.8},{10.4,-75.5},{7.88,-72.51},{7.13,-73.13},{10.92,-74.77},{4.45,-75.24},{4.58,-74.22},{11.26,-74.19},{4.15,-73.64},{4.81,-75.68},{5.06,-75.52},{6.33,-75.57},{10.48,-73.25},{1.21,-77.28},{3.89,-77.04},{8.76,-75.89},{2.94,-75.27},{6.17,-75.62},{4.53,-75.69},{7.06,-73.09},{2.42,-76.61},{3.54,-76.3},{9.29,-75.38},{4.83,-75.67},{6.16,-75.56},{7.09,-73.85},{4.09,-76.21},{5.55,-73.37},{11.54,-72.91},{11.39,-72.24},{4.31,-74.81},{5.72,-72.94},{7.07,-73.17},{1.61,-75.62},{7.89,-76.64},{4.75,-75.91},{3.91,-76.3},{5.69,-76.66},{4.82,-74.37}}

3. Si consideramos que Colombia no está sobre un plano, sino sobre la superficie de una figura que podemos aproximar por una esfera, la distancia se debe definir en coordenadas esféricas, de la siguiente forma:

ce[{lat_,lon_}]:= r {Cos[lon°] Cos[lat°], Sin[lon°] Cos[lat°], Sin[lat°]};

distfun[{lat1_,lon1_},{lat2_,lon2_}]:=VectorAngle[ce[{lat1, lon1}], ce[{lat2, lon2}]] r;

4. Aquí, es necesario usar el símbolo ° pues Mathematica trabaja en radianes y los datos de longitud y latitud están dados en grados sexagesimales. La letra r corresponde al radio de la tierra, que al ser buscado por Wolframalpha nos dice que en el ecuador corresponde a 6378.14 kilómetros. Utilizando una función incorporada en Mathematica FindShortestTour podemos determinar la mejor combinación para nuestro problema,

{dist, ruta} = FindShortestTour[coordenadas, DistanceFunction -> distfun]

El resultado nos presenta  dos datos, la distancia total más corta y el orden de la lista ciudades en que debemos realizar el recorrido:

{3698.13, {1, 12, 31, 35, 29, 36, 23, 7, 6, 16, 33, 32, 11, 8, 4, 5, 26, 19,
  38, 15, 2, 28, 21, 41, 14, 27, 13, 39, 22, 30, 40, 18, 25, 3, 24, 17, 37,
  20, 9, 34, 42, 10}}

La distancia total más corta es de 3698.13 kilómetros y la ciudad donde debemos comenzar es por la primera de la lista, luego la 12 y así sucesivamente para terminar en la número 10. 

CONCLUSIONES:

1. Dados los resultados anteriores, y que queremos el nombre concreto de las ciudades ubicamos   una nueva lista que se llamará nombre , que presentara la solución del problema.

En Mathematica se escribe de la siguiente forma: 

nombres = Transpose[ciudades[[ruta]]][[1]]

{Bogota,Villavicencio,Tunja,Sogamoso,Barrancabermeja,Giron,Floridablanca,Bucaramanga,Cucuta,Valledupar,Maicao,Riohacha,SantaMarta,Soledad,Barranquilla,Cartagena,Sincelejo,Monteria,Apartado,Bello,Medellin,Envigado,Itagui,Quibdo,Manizales,DosQuebradas,Pereira,Cartago,Armenia,Tulua,Buga,Buenaventura,Palmira,Cali,Popayan,Pasto,Florencia,Neiva,Ibague,Girardot,Facatativa,Soacha}

2. Para hallar  las coordenadas ordenadas,  creamos  una lista llamada línea, que nos permitirá ademásgraficar el recorrido, primero para que nos aparezcan los nombres y para que nos determine la ruta a seguir sobre el mapa del país, esta ruta es la ideal y el mapa se presenta a continuación, es también bajado como una herramienta del programa, los comandos para esto son:

linea = coordenadas[[ruta]];

texto = Graphics[Table[Tooltip[Point[aaa[[i]]], nombres[[i]]], {i, 1, 42, 1}]];

el mapa de Colombia, que lo obtenemos de Wolframalpha

colombia = Graphics[{Gray, CountryData["Colombia", "Polygon"]}, Frame -> True];

y la ruta que se debe seguir, que llamaremos trazo

trazo=ListPlot[Table[{linea[[i,2]],linea[[i,1]]},{i,1,42,1}],Joined -> True];

Ahora, la ruta ideal

Show[colombia, trazo, texto, PlotRange -> {{-80, -66}, {-5, 15}}]

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 G. H. Hardy

Los idiomas mueren,
pero las ideas matemáticas sobreviven.

G. H. Hardy

Teorema de Napoleón

Descargar como Notebook

En geometría, el teorema de Napoleón es un resultado sobre triángulos equiláteros; se le atribuye a Napoleón Bonaparte (1769 - 1821), si bien no hay pruebas tangibles de que sea el verdadero autor. Aparece publicado en el calendario The Ladies' Diary de 1825, es decir cuatro años después su muerte .

El teorema dice: Si sobre los lados de un triángulo arbitrario, en el exterior de este, se construyen triángulos equiláteros, entonces los centros de estos triángulos son también vértices de un triángulo equilátero.

vertice[a_, b_] := 
 Module[{cc = Arg[(a - b)[[1]] + I (a - b)[[2]]] + Pi/3}, 
  b + EuclideanDistance[a, b] {Cos[cc], Sin[cc]}]
triangulo[color_, a_, b_] := {color, Opacity[0.5], 
  Triangle[{a, b, vertice[a, b]}]}
centro[a_, b_] := TriangleCenter[{a, b, vertice[a, b]}, "Incenter"]

Manipulate[
 Graphics[{{Line[{p, q, s, p}]}, triangulo[Red, p, q], 
   triangulo[Yellow, s, p], 
   triangulo[Green, q, s], {PointSize[Large], 
    Point[{centro[p, q], centro[q, s], centro[s, p]}]}, {Red, 
    Thickness[0.01], 
    Line[{centro[p, q], centro[q, s], centro[s, p], centro[p, q]}]}}, 
  PlotRange -> 5], {{p, {1, 1}}, Locator}, {{q, {-1, 1}}, 
  Locator}, {{s, {-1, -1}}, Locator}]

Observemos que con cuadrados en vez de triángulos no es cierto.

cuadrado[color_, a_, b_] := 
 Module[{tt = EuclideanDistance[a, b]}, {color, Opacity[0.5], 
   Rotate[{Rectangle[b, b + {tt, tt}], {Black, PointSize[Large], 
      Point[RegionCentroid@Rectangle[b, b + {tt, tt}]]}}, 
    Arg[(a - b)[[2]] + I (b - a)[[1]]] + Pi/2, b]}]
punto[a_, b_] := 
 Module[{cc = Arg[(a - b)[[1]] + I (a - b)[[2]]] + Pi/4}, 
  b + Sqrt[2] EuclideanDistance[a, b]/2 {Cos[cc], Sin[cc]}]

Manipulate[
 Graphics[{Line[{p, q, s, p}], cuadrado[Red, p, q], 
   cuadrado[Yellow, s, p], 
   cuadrado[Green, q, s], {Red, Thickness[0.01], 
    Line[{punto[p, q], punto[q, s], punto[s, p], punto[p, q]}]}}, 
  PlotRange -> 5], {{p, {1, 1}}, Locator}, {{q, {-1, 1}}, 
  Locator}, {{s, {-1, -1}}, Locator}]

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 Carl Sagan

En algún lugar algo increíble
está esperando ser descubierto.

Carl Sagan

Optimizando el cruce de un río

Descargar como Notebook

Un hombre desea ir desde el punto A hasta el punto B atravesando un río de orillas paralelas y rectas de tres kilómetros de ancho. La orilla del río entre C, proyección perpendicular del punto A sobre el río, y B es de ocho kilómetros.

Determinar la ubicación del punto P, en términos de la distancia X al punto C, tal que si la velocidad nadando por el río de A a P es Vn y la velocidad corriendo por la orilla del río de P a B es Vc el tiempo sea mínimo.

Graphics[{{LightBlue, Rectangle[{0, 0}, {8, 1}]}, {PointSize[0.01], 
   Point[{0, 1}], Point[{0, 0}], Point[{8, 1}], Point[{4, 1}]}, 
  Text["P", {4, 1.2}], Text["A", {-0.2, -0.2}], 
  Text["C", {-0.2, 1.2}], 
  Text["Nadando", {2, 0.6}, Automatic, {4, 1}], 
  Text["Corriendo", {6, 1.2}], Text["X", {2, 1.3}], 
  Text["B", {8, 1.2}], Text["8 Kms.", {4, -1}], 
  Text["3 Km.", {9, 0.5}], {Arrowheads[Small], 
   Arrow[{{0, -0.5}, {8, -0.5}}]}, {Arrowheads[0.02, -0.01], 
   Arrow[{{0, 1.2}, {3.9, 1.2}}]}, {Arrowheads[Small], 
   Arrow[{{8.5, 0}, {8.5, 1}}]}, {Red, 
   Line[{{0, 0}, {4, 1}, {8, 1}}]}}, Axes -> False]

Sabemos que velocidad es espacio sobre tiempo por tanto tiempo es igual a distancia sobre velocidad, y el tiempo total es la suma de los dos tiempos empleados nadando y corriendo.

El tiempo en función de X está dado por:

El tiempo mínimo es:

Tomamos la solución positiva, y al calcularla en T, obtenemos:

Si la velocidad nadando Vn es mayor o igual que la velocidad corriendo Vc, la solución es nadar directo de A hasta B. Así vamos a suponer que Vc > vn.

En el siguiente aplicativo vamos a manipular las velocidades y la posición del punto P, y cuando lo deseemos nos va a mostrar en ambas gráficas el punto mínimo donde se debe ubicar P.

Observemos, antes de activar la ubicación del punto mínimo, el comportamiento de la gráfica del tiempo vs. la distancia X conforme cambiamos las velocidades e intentemos predecir el comportamiento del punto mínimo al variar las velocidades. Luego activemos el punto mínimo y corroboremos nuestras predicciones.



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 Mickaël Launay

Debemos enseñar matemáticas 
que tengan sentido para los estudiantes.

Mickaël Launay

Números Polidivisibles

Descargar como Notebook

Un número cuyas cifras son abcd... se dice polidivisible (en base 10) si cumple las siguientes condiciones :
 ✪ a no es cero,
 ✪ ab es múltiplo de 2
 ✪ abc es múltiplo de 3
 ✪ abcd es múltiplo de 4
 ✪ y así sucesivamente . . .

Por ejemplo, el 426 es polidivisible, ya que 4 no es 0, el número 42 es múltiplo de 2 y el número 426 es múltiplo de 3. Pero 435 no lo es, ya que 43 no es múltiplo de 2.

Un resultado importante para la construcción de los números polidivisibles es: Si un número de dos o más cifras es polidivisible sus primeros dígitos forman también un número polidivisible.

En Mathematica

Definimos la función poli[n] que genera los números polidivisibles con n dígitos, que está definida por recurrencia: definimos poli[1] como los números de 1 a 9, pues ellos cumplen la primera propiedad para ser polidivisibles (no ser cero), y los demás en términos del anterior agregándole una cifra al final y comprobando si es divisible por su número de cifras.

poli[1] = Range[9];
poli[n_] := 
 Module[{aa = poli[n - 1]}, 
  Select[Flatten@
    If[EvenQ[n], 
     Table[FromDigits[Join[IntegerDigits[aa[[k]]], {p}]], {k, 
       Length[aa]}, {p, 0, 8, 2}], 
     Table[FromDigits[Join[IntegerDigits[aa[[k]]], {p}]], {k, 
       Length[aa]}, {p, 0, 9}]], Divisible[#, n] &]]

Cantidad de números polidivisibles por cada cantidad de dígitos:

Table[{n, Length[poli[n]]}, {n, 30}] // TableForm

poli[25]
{3608528850368400786036725}


Hay 20456 números polidivisibles (en base 10), el más grande de todos ellos es el número

3608528850368400786036725

que es de 25 cifras.

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 Paul Hoffman

Las matemáticas son el camino a la inmortalidad.
Si usted hace un gran descubrimiento en matemáticas,
será recordado después de que todos los demás serán olvidados.

Paul Hoffman

Teorema de van Aubel

Descargar como Notebook

Se debe a la publicación realizada en 1878 por H. H. van Aubel.

Dado un cuadrilátero cualquiera en un plano, a partir de cada lado dibujamos un cuadrado apoyado en él. Entonces los segmentos que unen los centros de cuadrados situados en lados opuestos tienen la misma longitud y además son segmentos perpendiculares ellos o sus prolongaciones.

cuadrado[color_, a_, b_] := 
 Module[{tt = EuclideanDistance[a, b]}, {color, Opacity[0.5], 
   Rotate[{Rectangle[b, b + {tt, tt}], {Black, PointSize[Large], 
      Point[RegionCentroid@Rectangle[b, b + {tt, tt}]]}}, 
    Arg[(a - b)[[2]] + I (b - a)[[1]]] + Pi/2, b]}]
punto[a_, b_] := 
 Module[{cc = Arg[(a - b)[[1]] + I (a - b)[[2]]] + Pi/4}, 
  b + Sqrt[2] EuclideanDistance[a, b]/2 {Cos[cc], Sin[cc]}]
linea[a_, b_, c_, d_] := 
 ParametricPlot[punto[a, b] (1 - t) + t punto[c, d], {t, 0, 1}, 
  PlotStyle -> {Red, Thickness[0.01]}]
lineap[a_, b_, c_, d_] := 
 ParametricPlot[punto[a, b] (1 - t) + t punto[c, d], {t, -5, 6}, 
  PlotStyle -> {Orange, Dashed}]


Manipulate[
 Show[Graphics[{{Line[{p, q, s, r, p}]}, cuadrado[Red, p, q], 
    cuadrado[Yellow, s, r], cuadrado[Green, q, s], 
    cuadrado[Orange, r, p]}, PlotRange -> 10], lineap[p, q, s, r], 
  lineap[q, s, r, p], linea[p, q, s, r], 
  linea[q, s, r, p]], {{p, {1, 1}}, Locator}, {{q, {-1, 1}}, 
  Locator}, {{s, {-1, -1}}, Locator}, {{r, {1, -1}}, Locator}]

Este teorema es cierto sin importar si el cuadrilátero es o no convexo, y también si es o no simple.

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 Carl Sagan

La ciencia es más que un simple conjunto de conocimientos:
es una manera de pensar.

Carl Sagan

Corazón Por mes de Amor y Amistad

Descargar como Notebook

Colaboración del Profesor Jony Romero

Manipulate[
 Plot[{(-x)^(2/3) + 0.9 Sqrt[3.3 - x^2] Sin[-a \[Pi] x], 
   x^(2/3) + 0.9 Sqrt[3.3 - x^2] Sin[a \[Pi] x]}, {x, -3, 3}, 
  PlotRange -> 3, Axes -> False, PlotStyle -> Red, 
  PlotPoints -> 100], {a, 1, 20, 0.5}]

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