Problema 137

Enunciado

En la revista trianguloscabri, editada por el profesor Ricardo Barroso de la Universidad de Sevilla,aparece el siguiente problema (propuesto por José Nogareda Villar, profesor de matemáticas del IES"Ramón Olleros de Béjar" de Salamanca):

Sea ABC un triángulo. Sea P un punto que no pertenezca al mismo.Trazar por P una recta de manera que corte al triángulo en dos figuras geométricas de la misma área.

Inicialización

Aquí definimos un procedimiento para dibujar un circulito que represente a un punto. Le indicamos las coordenadas, el color, el texto de la etiqueta y la posición relativa de la etiqueta con el punto.

\(\(\(punto[p1_, p2_, color_, etiqueta_, dx_, dy_] := 
        Module[{}, 
{color, 
Disk[{p1, 
                p2}, 0.01], 
RGBColor[0, 0, 
              0], 
Circle[{p1, p2}, 
              0.01], 
Text[
              etiqueta, {p1 + dx, 
                p2 + dy}, 
TextStyle -> {FontFamily -> "Times", FontSize -> 12}]}];\)\(
\)
    \)\)

Un dibujo aproximado

Asignamos coordenadas a los vértices de manera que A=(u,v), B=(0,0), C=(c,0). Tracemos una recta que pasa por P=(x0, y0) y llamemos E y F a la intersección de dicha recta con los lados AB y AC, respectivamente.

c := 1;

    u := 0.8;  v := 0.6;

    x0  :=  0.5;  y0 :=  0.3;

    e1 := 0.7  u;  e2  :=  0.7 v;

    f1  := 0.75 c;  f2  := 0;

    p1  := 0.4 e1  +  0.6  f1;

    p2  := 0.4 e2  +  0.6 f2;

    

    margen  :=  0.08;

    grafico  = {
RGBColor[1, 1, 
            0.8], 
Polygon[{{0, 0}, {c, 0}, {u, v}, {0, 
                0}}], 
RGBColor[0, 0, 
            0], 
Line[{{0, 0}, {c, 0}, {u, v}, {0, 
                0}}], 
Line[{{e1, e2}, {f1, 
                0}}], 
punto[0, 0, 
            RGBColor[1, 1, 1],  "B", 
            0, -0.05], 
punto[c, 0, 
            RGBColor[1, 1, 1],  "C", 
            0, -0.05], 
punto[u, v, 
            RGBColor[1, 1, 1],  "A", 0, 0.04], 
punto[
            e1, e2, RGBColor[1, 1, 1],  "E", -0.03, 
            0.02], 
punto[f1, 0, 
            RGBColor[1, 1, 1],  "F", 
            0, -0.05], 
punto[p1, p2, 
            RGBColor[1, 1, 1],  "P", 0.04, 
            0.04]
};

    Show[Graphics[grafico], 
      AspectRatio -> 
        Automatic, 
PlotRange -> {{-margen, 
            c + margen}, {-margen, v + margen}}]

Cálculos

Los puntos E y F

Llamamos m a la pendiente de la recta que pasa por P.La recta que pasa por P tiene ecuación y=y0 + m(x-x0). Las rectas de los lados AB y AC tienen por ecuaciones vx-uy=0 e y=0, respectivamente.Hallamos E y F como intersección de estas rectas:

Clear[u, v, x0, y0, c]
Simplify[
      Solve[{v x  - u y  == 0, 
          y ==  y0  +  m (x - x0)}, {x, 
          y}]]
Simplify[
      Solve[{ y  == 0, y ==  y0  +  m (x - x0)}, {x, 
          y}]]

La pendiente m

Conocidas las coordenadas de E y F, podemos hallar (salvo un signo) el área de triángulo EBF:

e1 := ((u (m x0 - y0))/(m u - v));  
    e2 := ((v (-m x0 + y0))/(-m u + v));
f1 := x0 - (y0/m); f2 := 0;
Simplify[(1/2) 
        Det[{{1, 0, 0}, {1, e1, e2}, {1, f1, f2}}]]

Esta debe ser la mitad del área del triángulo ABC:

Solve[((v (((-m x0 + y0))^2))/(2 m (m u - v))) ==  ((c v)/4), m]

Datos de la hipérbola

En primer lugar podemos ver que la hipérbola es tangente a las medianas:

Solve[{8 u y^2  -  8 v x y  +  c v^2  == 0, 
        y == -v/(c/2 - u) (x - c/2)}, {x, y}]

Solve[{8 u y^2  -  8 v x y  +  c v^2  == 0, 
        y == -(v/2)/(c - u/2) (x - c)}, {x, 
        y}]

Ahora calculamos la intersección de la hipérbola y el lado BC:

Solve[{8 u y^2  -  8 v x y  +  c v^2  == 0, 
        y == -v/(c - u) (x - c)}, {x, y}]

La solución

Hagamos ahora un gráfico en el que se muestre la solución del problema para un punto determinado en cada uno de los tres casos posibles

\(\(\(hacergrafico[x0_, y0_, archivo_]\  := \ 
      Module[{k1, k2, u, v, c, e1, e2, m1, 
          m2}, 
{c := 1; 
u := 0.8; \ 
          v := 0.7; 
e1\  := \ {0, 0}; \ e2 := {0, 0}; 
          f1 := {0, 0}; 
          f2 := {0, 
              0}; 
m1\  := \ \(c\ v - 4\ x0\ y0 - \@c\ \@\(c\ v\^2 - 8\ v\ x0\ y0 + 8\ u\ y0\^2\)\)\/\(2\ \((c\ u - 2\ x0\^2)\)\); 
k1 := \(\(\ \)\(m1\ x0 - y0\)\)\/\(m1\ u - v\); 
          e1 := \ k1\ u; \ e2 := k1\ v; f1 := x0 - y0\/m1; 
          f2 := 0; 
m2\  := \ \(c\ v - 4\ x0\ y0 + \@c\ \@\(c\ v\^2 - 8\ v\ x0\ y0 + 8\ u\ y0\^2\)\)\/\(2\ \((c\ u - 2\ x0\^2)\)\); 
k2 := \(\(\ \)\(m2\ x0 - y0\)\)\/\(m2\ u - v\); 
          e3 := \ k2\ u; \ e4 := k2\ v; f3 := x0 - y0\/m2; 
          f4 := 0; 
margen\  := \ 
            0.08; 

For[
            hiperbola\  = \ {}; 
\ \ \ \ \ i = 5\ , 
            i < 100, \(i++\), {
y = 
                v*i/100; 
x = \((c\ v\^2 + 
                      8\ u\ y\^2)\)/\((8  
                      v\ y)\); 
hiperbola\  = \ 
                Append[hiperbola, {x, 
                    y}];
}
]; 
grafico\  = {
RGBColor[1, 1, 
                0.8], 
Polygon[{{0, 0}, {c, 0}, {u, v}, {0, 
                    0}}], 
RGBColor[0, 0, 
                0], 
Line[
                hiperbola], 
Line[{{0, 0}, {c, 0}, {u, 
                    v}, {0, 0}}], 
Line[{{u, v}, {c/2, 
                    0}}], 
Line[{{u/2, v/2}, {c, 
                    0}}], 
RGBColor[1, 0, 
                0], 
If[\((Im[m1] == 
                      0)\)\  && \ \((k1 < 1)\)\  && \ \((f1\  < \ c)\), 
                Line[{{e1, e2}, {f1, f2}}]\ ], \ 
RGBColor[
                0, 1, 0], 
If[\((Im[m2] == 
                      0)\)\  && \ \((k2 < 1)\), 
                Line[{{e3, e4}, {f3, f4}}]\ ], 
RGBColor[0, 
                0, 0], 
punto[0, 0, 
                RGBColor[1, 1, 1], \ "B", 
                0, \(-0.05\)], 
punto[c, 0, 
                RGBColor[1, 1, 1], \ "C", 
                0, \(-0.05\)], 
punto[u, v, 
                RGBColor[1, 1, 1], \ "A", 0, 0.04], 
If[
                Im[m1] == 0\  && \ \((k1\  > \ 1/2)\), 
                punto[e1, e2, RGBColor[1, 1, 1], \ "E", \(-0.03\), 
                  0.02]], 
If[\((Im[m1] == 
                      0)\)\  && \ \((f1\  > \ c/2)\), \ 
                punto[f1, 0, RGBColor[1, 1, 1], \ "F", 
                  0, \(-0.05\)]], 
If[\((Im[m2] == 
                      0)\)\  && \ \((k2\  > \ 1/2)\), 
                punto[e3, e4, RGBColor[1, 1, 1], \ "E'", \(-0.03\), 
                  0.02]], 
If[\((Im[m2] == 
                      0)\)\  && \ \ \((f3\  > c/2)\) && \ \((f3\  < \ c)\), 
                punto[f3, f4, RGBColor[1, 1, 1], \ "F'", 
                  0, \(-0.05\)]], 
punto[x0, y0, 
                RGBColor[1, 1, 1], \ "P", 0.04, 
                0.02]}; 
Show[Graphics[grafico], 
              AspectRatio -> 
                Automatic, 
PlotRange -> {{\(-margen\), c + margen}, {\(-margen\), 
                    v + margen}}]\ \ 

Export[
              StringJoin["C:/NewDocs/temas/12-trianguloscabri137/", \ \ archivo, ".gif"], 
Graphics[grafico, 
                AspectRatio -> 
                  Automatic, 
PlotRange -> {{\(-margen\), c + margen}, {\(-margen\), 
                      v + margen}}]\ ]

Export[
              StringJoin["C:/NewDocs/temas/12-trianguloscabri137/", \ \ archivo, ".eps"], 
Graphics[grafico, 
                AspectRatio -> 
                  Automatic, 
PlotRange -> {{\(-margen\), c + margen}, {\(-margen\), v + margen}}]]}]\)\(
\)
    \)\)
hacergrafico[0.62, 0.25,  "grafico1"]
hacergrafico[0.62, 0.41,  "grafico2"]
hacergrafico[0.70, 0.11,  "grafico3"]

Francisco Javier García Capitán, 2004
pacoga@ctv.es