Entrada destacada

Distancia media de dos puntos en un cuadrado unitario

martes, 30 de enero de 2018

Sumas Parciales de la Exponencial Compleja



Calculamos las sumas parciales de la función exponencial


donde m corresponde al mes, d al día y y al año. Se van realizando las sumas parciales y se determina las coordenadas de su parte real e imaginaria y se conectan por medio de un segmento de recta.

Definimos la función






ListPlot[Table[ReIm[f[n, 21, 11, 17]], {n, 2000}], ImagePadding -> 40,AspectRatio -> 1, PlotStyle -> Directive[Red, PointSize[.02]], 
 Joined -> True]


Explore cambiando la fecha por la de algún evento especial.

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


viernes, 26 de enero de 2018

martes, 23 de enero de 2018

Teorema de Pick



Se debe al matemático Austriaco Georg Alexander Pick, de ascendencia judía y victima del holocausto nazi, quien lo publicó en 1899. El teorema da una fórmula para determinar el área A de los polígonos simples (no se auto cruzan, es una región conexa) cuyos vértices tienen coordenadas enteras, determinando el número de puntos con coordenadas enteras en su frontera fr y en su interior int, la fórmula es:

A = int - 1 + fr/2

En Mathematica

Lo desarrollaré sobre una cuadrícula 10x10 que contiene sus bordes, los puntos fr (frontera) se pintan de azul y los puntos int (interiores) de verde.

La función RegionBoundary[ ] nos determina los puntos sobre la frontera del polígono y la función RegionMember[ ] nos dice si un punto pertenece o no a la región.

puntos = Flatten[Table[{i, j}, {i, 0, 10}, {j, 0, 10}], 1];
Manipulate[pts = Floor[pts];
 pol = Polygon[pts]; int = {}; fr = {};
 a = 0; Do[
  Which[RegionMember[RegionBoundary[pol], puntos[[n]]], 
   AppendTo[fr, puntos[[n]]], 
   Head[RegionMember[pol, puntos[[n]]]] === RegionMember, a++, 
   RegionMember[pol, puntos[[n]]], AppendTo[int, puntos[[n]]]], {n, 
   121}];

 Grid[{{Grid[{{"Puntos interiores", Length[int]}, {"Puntos frontera", 
       Length[fr]}, {"Area=int-1+fr/2", 
       If[a == 0, (Length[int] - 1 + 
           Length[fr]/2) "\!\(\*SuperscriptBox[\(Unid\), \(2\)]\)", 
        "El polígono no es simple"]}}], 
    Graphics[{PointSize[0.04], Blue, Point[fr], Green, Point[int], 
      Pink, Opacity[0.2], EdgeForm[Directive[Dashed, Thick, Red]], 
      pol}, Axes -> True, GridLines -> {Range[0, 10], Range[0, 10]}, 
     PlotRange -> {{0, 10}, {0, 10}}, 
     ImageSize -> Large]}}], {{pts, {{0, 0}, {5, 9}, {10, 0}}}, 
  Locator, ContinuousAction -> False, LocatorAutoCreate -> True}, 
 SaveDefinitions -> True]



Se pueden mover los vértices capturándolos con el Mouse, y crear nuevos vértices con Alt+Click en Windows y Command+Click en Mac.



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


viernes, 19 de enero de 2018

Frase Célebre de H. G. Forder

Aquel que desdeña de la geometría de Euclides, 
es como hombre que, que al regresar de tierras extrañas, menosprecia su casa.

H. G. Forder

martes, 16 de enero de 2018

Problema de Circunferencias Tangentes Inscritas en un Cuadrado



Dado un cuadrado de lado L donde se traza media circunferencia con diámetro uno de los lados, determinar el radio r (en términos de L) de la mayor circunferencia que se puede trazar interior al cuadrado y exterior a la media circunferencia.

Deseamos determinar el valor de r en términos de L en la gráfica:



Introducimos un sistema de coordenada cartesianas con origen el centro de la media circunferencia y determinamos el centro de la circunferencia con respecto al sistema de coordenadas:




Ahora, determinamos la ecuación de la recta que pasa por el centro de las dos circunferencias, y por tanto, por el punto de tangencia entre ellas:




Resolvemos el siguiente sistema de ecuaciones, para determinar las coordenadas del punto (a,b) antípoda con el punto de tangencia en la circunferencia máxima de radio r :



donde el punto (a,b) satisface: en (1) la ecuación de la circunferencia de máximo radio r y en (2) la ecuación de la recta que pasa por los centros de las circunferencias, como vamos a encontrar dos puntos tomaremos el de mayor valor en la abscisa (primera componente).

Resolvemos el sistema por el comando Reduce, adicionando las condiciones que las variables que intervienen son números reales y L/2 > r > 0:

Clear[a, b, L, r]
Reduce[{(a - L/2 + r)^2 + (b - L + r)^2 == r^2, 
  b == ((2 L - 2 r)/(L - 2 r)) a, L/2 > r, r > 0}, {L, r, a, 
  b}, Reals]






Así, las coordenadas del punto (a, b) son :



Por último, se debe cumplir que la distancia desde el origen al punto (a, b) debe ser igual a L/2 + 2 r, por tanto resolvemos :

a = (L - 2 r)/2 + 
   Sqrt[(L^2 r^2 - 4 L r^3 + 4 r^4)/(5 L^2 - 12 L r + 8 r^2)];
Reduce[{EuclideanDistance[{0, 0}, {a, ((2 L - 2 r)/(L - 2 r)) a}] == 
   L/2 + 2 r, L/2 > r, r > 0}, r, Reals]





Así, la relación entre r y L es :




y el código con el cual realizamos la primera gráfica es :

L = 1; r = (2 - Sqrt[3]) L;
gra1 = Graphics[{Line[{{L/2, 0}, {L/2, L}, {-L/2, L}, {-L/2, 0}, {L/2, 0}}], Line[{{L/2 - r, L - r}, {L/2 - r, L - r} + r Sqrt[2]/2 {1, 1}}], Text["r", {5 L/16, 7 L/8}], Line[{{0, 0}, Sqrt[2]/4 {L, L}}], Text["L/2", {L/4, L/8}],Point[{{0, 0}, {L/2 - r, L - r}}], {Arrowheads[{-.05, .05}], Arrow[{{9/16, 0}, {9/16, 1}}], Text["L", {10/16, 1/2}], Arrow[{{-1/2, 17/16}, {1/2, 17/16}}]}, Text["L", {0, 18/16}]}];

Show[ContourPlot[{x^2 + y^2 == L^2/4, (x - L/2 + r)^2 + (y - L + r)^2 == r^2}, {x, -10/16, 10/16}, {y, 0, 10/8}, Frame -> None, Axes -> False, AxesLabel -> None, Ticks -> None], gra1]



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


viernes, 12 de enero de 2018

Frase Célebre de Albert Einstein

¿Cómo puede ser que la matemática, siendo al fin y al cabo un producto del pensamiento humano independiente de la experiencia, esté tan admirablemente bien adaptada a los objetos y leyes de la realidad?

Albert Einstein

martes, 9 de enero de 2018

Suma de los Dígitos de un número elevados a ellos mismos



Números de Munchausen

Buscamos los números enteros positivos tales que sean iguales a sus dígitos elevados a ellos mismos, por ejemplo:

aaa = IntegerDigits[123]
{1,2,3}

aaa^aaa
{1,4,27}

Total[{1, 4, 27}]
32

Si 32 fuera igual al número inicial 123 entonces este sería uno de estos números. Tenemos que descartar los números que tengan a cero como uno de sus dígitos pues tendría la indeterminación cero a la cero.

El término fue acuñado por el ingeniero de software y matemático holandés Daan van Berkel en 2009. ​ El nombre se debe a que cada dígito está "elevado" por sí mismo, esto evoca la historia de Barón de Munchausen que se elevó a sí mismo hacia arriba jalando su propia coleta.

Realizando la búsqueda hasta quinientos millones encontramos que:

pic = {};
Do[aa = If[FreeQ[IntegerDigits[n], 0], IntegerDigits[n]];
 If[Total[aa^aa] == n, AppendTo[pic, n]], {n, 500000000}]
pic

{1,3 435, 438 579 088}

los únicos números con esta propiedad menores a quinientos millones.

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


viernes, 5 de enero de 2018

Problema del Cumpleaños

Para el siguiente problema es posible utilizar Mathematica, pero puede parecer arreglar el jardín de la casa con un tractor, pero es una buena introducción a un próximo problema que sí necesitará Mathematica. Su planteamiento es el siguiente:

Alberto y Bernardo acaban de conocer a Claudia y desean saber el día de su cumpleaños. Ella les da una lista de diez posibles fechas:

          15 de mayo            16 de mayo         19 de mayo
          17 de junio             18 de junio
          14 de julio              16 de julio
          14 de agosto          15 de agosto       17 de agosto

Entonces Claudia le dice a Alberto cual es el mes de su cumpleaños y a Bernardo el día, Alberto sabe que Bernardo conoce el día y Bernardo sabe que Alberto conoce el mes. Cabe aclarar que ambos son personas muy lógicas, y se produce la siguiente conversación:

Alberto: No sé cuando es el cumpleaños de Claudia, pero sé que Bernardo tampoco lo sabe.

Bernardo: Al principio no sabía cuando era el cumpleaños de Claudia, pero después de lo que dijo Alberto, ahora sí lo sé.

Alberto: Entonces yo también sé cuando es el cumpleaños de Claudia.

Ahora, ¿cuándo es el cumpleaños de Claudia?

Al parecer este problema apareció en las SASMO (Singapore and Asian Schools Math Olympiads), y se propuso en la prueba para chicos de 14 a 16 años.


martes, 2 de enero de 2018

Frase Célebre de Henri Lebesgue

En mi opinión un matemático, en tanto que es un matemático, 
no necesita preocuparse de filosofía: una opinión que de todos modos ha sido expresada por muchos filósofos.

Henri Lebesgue