4
$\begingroup$

I am trying to demonstrate properties of the Gergonne point of a triangle. I can draw the triangle and its in-circle, but I'm having trouble finding the points of tangency for the in-circle. These and the triangle's vertices locate the Gergonne point.

This is my code:

InCircle[{x1_, y1_}, {x2_, y2_}, {x3_, y3_}] := With[{
u = Norm[{x2, y2} - {x3, y3}],
v = Norm[{x3, y3} - {x1, y1}],
w = Norm[{x1, y1} - {x2, y2}]}, 
Circle[(u {x1, y1} + v {x2, y2} + w {x3, y3})/(u + v + w), 
1/2 Sqrt[-(((u - v - w) (u + v - w) (u - v + w)))/(u + v + w)]]];
Manipulate[
Graphics[{Thick, Green, Line[{a[[1]], a[[2]], a[[3]], a[[1]]}], Red, 
Thick, InCircle[a[[1]], a[[2]], a[[3]]]}, 
PlotRange -> 6.0], {{a, {{-1, -1}, {1, -1}, {0, 1}}}, Locator}]    

I've tried to use "inter" but it doesn't work.

$\endgroup$
2
  • $\begingroup$ What do you mean by "inter"? $\endgroup$
    – m_goldberg
    May 12, 2018 at 23:10
  • $\begingroup$ Your question has been answered, and there are things to do after that. Its good practice to wait 24 hours for other answers before up-voting and accepting the best one for you. I think now is time to either clarify or accept the best answer. Participation is essential for the site, please do your part. $\endgroup$
    – rhermans
    May 29, 2018 at 16:43

3 Answers 3

6
$\begingroup$

A function for the triangle incircle.

Incircle[{{x1_, y1_}, {x2_, y2_}, {x3_, y3_}}] := 
   With[{a = Sqrt[Apply[Plus, {x2 - x3, y2 - y3}^2]], 
         b = Sqrt[Apply[Plus, {x3 - x1, y3 - y1}^2]], 
         c = Sqrt[Apply[Plus, {x1 - x2, y1 - y2}^2]]}, 
        Circle[(a {x1, y1} + b {x2, y2} + c {x3, y3})/(a + b + c), 
           1/2 Sqrt[-(((a - b - c) (a + b - c) (a - b + c))/(a + b + c))]]]

The incircle contact points can be found as follows.

IncircleContacts[{{x1_, y1_}, {x2_, y2_}, {x3_, y3_}}] :=
   With[{a = Norm[{x2, y2} - {x3, y3}],
         b = Norm[{x1, y1} - {x3, y3}], 
         c = Norm[{x1, y1} - {x2, y2}]}, 
      {{(a (x1 - x2) + b (-x1 + x2) + c (x1 + x2))/(2 c),
        (a (y1 - y2) + b (-y1 + y2) + c (y1 + y2))/(2 c)}, 
       {((b - c) (x2 - x3) + a (x2 + x3))/(2 a),
        ((b - c) (y2 - y3) + a (y2 + y3))/(2 a)},
       {(a (x1 - x3) + c (-x1 + x3) + b (x1 + x3))/(2 b),
        (a (y1 - y3) + c (-y1 + y3) + b (y1 + y3))/(2 b)}}]

A function for the intersection point of two lines.

IntersectLines[{{x1_, y1_}, {x2_, y2_}}, {{u1_, v1_}, {u2_, v2_}}] :=
   Module[{det = (-y1 + y2) (u1 - u2) - (x1 - x2) (-v1 + v2)},
      If[N[det] =!= 0.,
        (1/det)*
           {-(x2 y1 - x1 y2) (u1 - u2) + (x1 - x2) (u2 v1 - u1 v2),
            (x2 y1 - x1 y2) (-v1 + v2) - (-y1 + y2) (u2 v1 - u1 v2)},
        {}]]

You can visualise the Gergonne point as follows.

Manipulate[
   Module[{a = Norm[v3 - v2], b = Norm[v3 - v1], c = Norm[v2 - v1], w, g},
      w = IncircleContacts[{v1, v2, v3}];
      g = IntersectLines[{v1, w[[2]]}, {v2, w[[3]]}];
      Graphics[{
         Thick, PointSize[0.02],
         Line[{v1, v2, v3, v1}],
         Red, Incircle[{v1, v2, v3}],
         Blue, Point[w],
         Blue, Line[{v1, w[[2]]}], Line[{v2, w[[3]]}], Line[{v3, w[[1]]}]
   }, PlotLabel -> {v1, v2, v3, g}]],
 {{v1, {0, 0}}, Locator},
 {{v2, {1, 0}}, Locator},
 {{v3, {0.3, 0.7}}, Locator}
]

Gergonne point

$\endgroup$
0
2
$\begingroup$

You can also use Region functionality::

GergonneGraphic[pts_]:=Module[{s=Insphere[SetPrecision[pts,16]], tangents, lines},
    tangents = Table[
        RegionIntersection[s, Line @ Delete[pts, i]],
        {i, 3}
    ];
    lines = MapThread[Line[{#[[1,1]], #2}]&, {tangents, pts}];
    gergonne = RegionIntersection @@ lines;
    Graphics[
        {
        Green, RegionBoundary @ Triangle[pts],
        Red, s,
        LightBlue, lines,
        Blue, tangents,
        Orange, PointSize[Large], gergonne
        },
        PlotRange->6
    ]
]

Manipulate[GergonneGraphic[a], {{a, {{-1, -1}, {1, -1}, {0, 1}}}, Locator}]

enter image description here

Note that I used SetPrecision to avoid issues with numeric fuzz that can cause the intersection of the incircle and the tangent line to be an empty region.

$\endgroup$
1
$\begingroup$
SeedRandom[123]
pts = RandomReal[1, {5, 3, 2}];
npts = Table[RegionNearest[Line@#, First[Insphere@p]] & /@ Subsets[p, {2}], {p, pts}];
Row[Table[Graphics[{Yellow, Polygon @ pts[[i]], Red, Insphere @ pts[[i]], 
 Blue, PointSize[Scaled[.05]], Point /@ npts[[i]]}, ImageSize -> 150], {i, 5}]]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.