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
