4
$\begingroup$

I want to build an inscribed circle into a triangle on a sphere. To do this, I first build its center - the intersection point of the bisectors. But there were problems with finding it. I build the intersection point of the bisectors in the plane of the triangle, and then I look for the corresponding point on the sphere, but judging by the graphical results, this is the wrong way.

sp[u_, v_] := {Sin[u] Cos[v], Sin[u] Sin[v], Cos[u]};
ark[{r1_, r2_}, nt_] := Table[
                        RotationTransform[ t VectorAngle[r1, r2], Cross[r1, r2]][r1],
                        {t, 0, 1, 1/nt}
                    ]

        A = sp[u1, v1];
        B = sp[u2, v2];
        C1 = sp[u3, v3];
        o = {0, 0, 0};
        a = Norm[B - C1];
        b = Norm[C1 - A];
        c = Norm[A - B];
        (* compute intersection point of the bisectors in the plane of the triangle *)
        B0 = (a*A + b*B + c*C1)/(a + b + c);
        B0 = B0/Norm[B0];
 (* compute bisectors *)
 aa = B + c/(c + b)*(C1 - B);
 bb = C1 + a/(c + a)*(A - C1);
 cc = A + b/(b + a)*(B - A);
 aa = aa/Norm[aa];
 bb = bb/Norm[bb];
 cc = cc/Norm[cc];

My questions:

  1. How to find the center of an inscribed circle?
  2. How to find the bases of bisectors on the sides of a triangle?
  3. How to construct the circle itself?
$\endgroup$
4
  • 2
    $\begingroup$ In 2D, the easiest way is to use Insphere. If vertices is a list of three 2D coordinates representing your vertices, then Insphere[vertices] gives you the 2D sphere (aka circle) representing the inscribed circle. You can extract the center (the first part) or the radius (the second part). I haven't reverse-engineered your code, and I don't understand "build an inscribed circle into a triangle on a sphere", so I don't know how you want to extend this to 3D. $\endgroup$
    – lericr
    May 31, 2022 at 21:59
  • $\begingroup$ What is the meaning about triangle on a sphere? All of the point of the triangle are belong to sphere? $\endgroup$
    – cvgmt
    May 31, 2022 at 22:43
  • $\begingroup$ @cvgmt Usually it means that each pair of vertices are joined by a great circle (a great circle being the intersection of the sphere with a plane through the center). Another way to look at it is that, given three planes through the center of the sphere in general position, each pair of planes will intersect the sphere in two antipodal points, yielding six points in all. Specifying a triangle is equivalent to specifying three of the six points such that no pair of points are antipodal. (There's a degeneracy if one allows antipodal vertices.) $\endgroup$
    – Michael E2
    Jun 1, 2022 at 4:09
  • $\begingroup$ Could you load an example image of what you want from the web? $\endgroup$
    – Syed
    Jun 1, 2022 at 4:59

3 Answers 3

5
$\begingroup$

Here is a picture of what I think you're trying to find:

figure

It's a bit of a journey to get there, here's what I did...

Starting with some vertices for our triangle, we find the insphere using these vertices along with the center of the sphere.

SeedRandom[3];
vertices = RandomPoint[Sphere[], 3];
insphere = Insphere[Append[vertices, {0, 0, 0}]];

Let's assign some useful variables.

insphereCenter = insphere[[1]];
insphereRadius = insphere[[2]];
insphereCenterOffset = Norm[insphereCenter];

Thinking ahead, we want some sort of circular indicator at the surface. I'm not going to use a circle, but a cone. This is just for visualization purposes. The cone's side will be tangent to the sphere, so it will just cover the bit of the sphere inside our target circle. The cone at the surface is similar to the cone formed by the center of our insphere and the points of the insphere tangent to the planes that define the sides (great arcs) of the triangle. So, we need to find the original cone and calculate a scaling factor.

inconeHeight = insphereRadius*insphereRadius/insphereCenterOffset;
inconeRadius = Sqrt[insphereRadius^2 - inconeHeight^2];
surfaceScale = 1/Sqrt[Norm[insphereCenter]^2 - insphere[[2]]^2];

This is all just a bit of geometry, mostly Pythagoras.

Now we need to scale and relocate this cone. I started with a simple, axes-aligned cone at the origin and applied a sequence of transforms. First, translate it up to the same height as our insphere, then scale it (which also brings it up to surface level), then rotate it into position.

surfaceIncone = 
  (RotationTransform[{{0, 0, 1}, insphereCenter}]@*
   ScalingTransform[surfaceScale*{1, 1, 1}]@*
   TranslationTransform[{0, 0, insphereCenterOffset - inconeHeight}])[
     Cone[{{0, 0, 0}, {0, 0, inconeHeight}}, inconeRadius]];

Finally, here's how I generated the image above:

Graphics3D[
  {Green, Ball[{0, 0, 0}, .05], 
   Red, Ball[#, .05] & /@ vertices, 
   GrayLevel[.3], surfaceIncone, 
   Blue, Opacity[.4], InfinitePlane[{0, 0, 0}, Take[vertices, 2]], 
   InfinitePlane[{0, 0, 0}, Take[vertices, -2]], 
   InfinitePlane[{0, 0, 0}, Drop[vertices, {2}]], Opacity[.5], 
   Green, Sphere[]}]

There is no error detection here, so there are edge cases that won't produce correct results.

$\endgroup$
3
$\begingroup$

For completeness, I'm going to provide functions for generating the circumcircle and incircle of a spherical triangle:

sphericalCircumcircle[pts_] := Module[{cen, cosr, nrm},
         cen = Total[Cross @@@ Partition[pts, 2, 1, 1]];
         nrm = Norm[cen];
         cosr = Det[pts]/nrm; cen /= nrm;
         BSplineCurve[Composition[TranslationTransform[cen cosr], 
                                  RotationTransform[{{0, 0, 1}, cen}]][
                                  Sqrt[(1 - cosr) (1 + cosr)]
                                  {{1, 0, 0}, {1, 1, 0}, {-1, 1, 0}, {-1, 0, 0},
                                   {-1, -1, 0}, {1, -1, 0}, {1, 0, 0}}], 
                      SplineDegree -> 2, 
                      SplineKnots -> {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1}, 
                      SplineWeights -> {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]]

sphericalIncircle[pts_] := Module[{cen, sinr, nrm},
         cen = RotateLeft[Map[Norm, Cross @@@ Partition[pts, 2, 1, 1]]] . pts;
         nrm = Norm[cen];
         sinr = Det[pts]/nrm; cen /= nrm;
         BSplineCurve[Composition[TranslationTransform[cen Sqrt[(1 - sinr) (1 + sinr)]],
                                  RotationTransform[{{0, 0, 1}, cen}]][sinr
                                  {{1, 0, 0}, {1, 1, 0}, {-1, 1, 0}, {-1, 0, 0},
                                   {-1, -1, 0}, {1, -1, 0}, {1, 0, 0}}],
                      SplineDegree -> 2, 
                      SplineKnots -> {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1}, 
                      SplineWeights -> {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]]

Expressions for the appropriate radii and centers were derived through standard spherical trigonometry. Both of these functions use the NURBS representation of a circle (see e.g. Piegl and Tiller), and both assume that the spherical triangle is determined by three unit vectors, corresponding to a spherical triangle embedded in a unit sphere centered at the origin. (You should rescale and translate appropriately for spherical triangles on spheres with different centers or radii.)

As a concrete demonstration, generate a random spherical triangle:

BlockRandom[SeedRandom[1337, Method -> "MersenneTwister"]; (* for reproducibility *)
            tri = RandomPoint[Sphere[], 3];]

Visualize the triangle and its circumcircle and incircle:

(* http://mathematica.stackexchange.com/a/10994 *)
arc[center_?VectorQ, {start_?VectorQ, end_?VectorQ}] := Module[{ang, co, r},
    ang = VectorAngle[start - center, end - center];
    co = Cos[ang/2]; r = EuclideanDistance[center, start];
    BSplineCurve[{start, center + r/co Normalize[(start + end)/2 - center], end}, 
                 SplineDegree -> 2, SplineKnots -> {0, 0, 0, 1, 1, 1},
                 SplineWeights -> {1, co, 1}]]

Legended[Graphics3D[{{Opacity[0.6], Sphere[]},
                     {Directive[Red, AbsolutePointSize[6]], Point[tri]}, 
                     {Directive[Blue, AbsoluteThickness[3]], 
                      arc[{0, 0, 0}, #] & /@ Partition[tri, 2, 1, 1]},
                     {AbsoluteThickness[2],
                      {ColorData[97, 3], sphericalCircumcircle[tri]}, 
                      {ColorData[97, 4], sphericalIncircle[tri]}}},
                    Boxed -> False, ViewPoint -> {-2.4, 1.3, -2.}], 
         LineLegend[{Directive[AbsoluteThickness[2], ColorData[97, 3]], 
                     Directive[AbsoluteThickness[2], ColorData[97, 4]]},
                    {"spherical circumcircle", "spherical incircle"}]]

spherical triangle with circumcircle and incircle

$\endgroup$
1
$\begingroup$

I understand that you want to map the picture of a triangle with inscribed circle onto a sphere.

As there is a large distortion at the poles, I pad the image with white to make the image appear in the "temperate" zone of the sphere.

pts = {{-1, -1}, {0, 1}, {1, -1}};
gr = Graphics[{Circle[TriangleCenter[pts, "Incenter"], 
    TriangleMeasurement[pts, "Inradius"]], 
   Line[{{pts[[1]], pts[[2]]}, {pts[[2]], pts[[3]]}, {pts[[3]], 
      pts[[1]]}}], Red, PointSize[0.1], Point[pts[[1]]], Blue, 
   Point[pts[[2]]], Green, Point[pts[[3]]]}] 
{width, height} = ImageMeasurements[Image@gr, "Dimensions"][[;; 2]];
gr = ImagePad[gr, {3 { width, width}, {height, height}}, White];
SphericalPlot3D[1, {u, 0, Pi}, {v, 0,  2 Pi}, 
 TextureCoordinateFunction -> ({#5, 1 - #4} &), 
 PlotStyle -> Texture[gr], ViewPoint -> Left]

enter image description here

Note that there is a small error at the bottom of the circle. I do not know what this is, but I think this is a bug.

$\endgroup$

Your Answer

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

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