Wolfram Function Repository

Instant-use add-on functions for the Wolfram Language

Function Repository Resource:

 ThreePointArc

Source Notebook

Draw an arc through three points

Contributed by: Ed Pegg Jr

ResourceFunction["ThreePointArc"][{p1,p2,p3}]

gives a Circle arc starting at p1, going through p2 and ending at p3.

Details

If the three points are colinear, a Line will be returned.

Examples

Basic Examples (3) 

Find an arc through three points:

In[1]:=
pts = {{0, 1}, {1, 1}, {1, 0}}; arc = ResourceFunction["ThreePointArc"][pts]
Out[2]=

Show it:

In[3]:=
Graphics[{Point[pts], arc}]
Out[3]=

The middle point is in the mid-arc:

In[4]:=
Column[{#, Graphics[{Point[#], ResourceFunction["ThreePointArc"][#]}, ImageSize -> Tiny]}] & /@ Permutations[pts]
Out[4]=

Properties and Relations (2) 

Create a spline which passes through three points:

In[5]:=
pts = {{0, 1}, {1, 0}, {1, 1}}; spline = ResourceFunction["CubicSplineCurve"][pts]
Out[6]=

Create an arc through the same three points:

In[7]:=
arc = ResourceFunction["ThreePointArc"][pts]
Out[7]=

Compare the two:

In[8]:=
Graphics[{spline, arc, AbsolutePointSize[5], Point /@ pts}]
Out[8]=

Collinear points give a Line:

In[9]:=
ResourceFunction["ThreePointArc"][{{0, 1}, {0, 2}, {0, 3}}]
Out[9]=

Neat Examples (1) 

Find a representation of the smallest projective space with 15 points, 35 lines and 15 planes:

In[10]:=
pg23 = {{1, 4, 5}, {8, 9, 1}, {2, 10, 8}, {14, 12, 2}, {5, 11, 14}, {1, 3, 2}, {2, 7, 5}, {5, 13, 8}, {8, 6, 14}, {14, 15, 1}, {2, 6, 4}, {14, 7, 9}, {5, 15, 10}, {1, 13, 12}, {8, 3, 11}, {6, 11, 13}, {7, 4, 3}, {15, 9, 6}, {13, 10, 7}, {3, 12, 15}, {15, 8, 7}, {13, 2, 15}, {3, 14, 13}, {6, 5, 3}, {7, 1, 6}, {9, 3, 10}, {10, 6, 12}, {12, 7, 11}, {11, 15, 4}, {4, 13, 9}, {9, 2, 11}, {10, 14, 4}, {12, 5, 9}, {11, 1, 10}, {4, 8, 12}}; numbers = {8, 2, 14, 5, 1, 3, 6, 7, 15, 13, 11, 4, 9, 10, 12}; locations = Flatten[MapIndexed[ RootReduce[{Sin[2 (#2[[2]] - 2) Pi/5], Cos[2 (#2[[2]] - 2) Pi/5]} {2, .5, -1.378}[[#2[[1]]]]] &, Partition[numbers, 5], {2}], 1]; newloc = Last /@ Sort[Transpose[{numbers, locations}]]; colors = {Black, Gray, Cyan, Green, Red, Yellow, Blue}; Graphics[{AbsoluteThickness[1.6], MapIndexed[{colors[[Ceiling[#2[[1]]/5]]], ResourceFunction["ThreePointArc"][newloc[[#1]]]} &, pg23], MapIndexed[{{Black, Disk[#1, .12]}, {White, Disk[#1, .11]}, Style[Text[#2[[1]], #1], 20]} &, newloc]}, ImageSize -> {500, 500}]
Out[15]=

Requirements

Wolfram Language 13.0 (December 2021) or above

Version History

  • 1.0.0 – 08 December 2023

Related Resources

License Information