Entrada destacada

Corazón generado desde una Matriz

martes, 3 de diciembre de 2019

Teorema de van Aubel sobre un triángulo


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

martes, 19 de noviembre de 2019

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


martes, 5 de noviembre de 2019

Teorema de Napoleón


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