Braikenridge-Maclaurin Theorem

Eric W. Weisstein
January 11, 2002

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneGeometry/Braikenridge-MaclaurinTheorem.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Braikenridge-MaclaurinTheorem.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Figure

<<PlaneGeometry`;
<<Graphics`;

f[{x_,y_},{b_,c_,d_,f_,g_}]:=x^2+2b x y+c y^2+d x +f y+g==0

conic[pts_,{x_,y_}]:=f[{x,y},coniccoefs[pts,{x,y}]]

coniccoefs[pts_,{x_,y_}]:={b,c,d,f,g}/.Solve[f[#,{b,c,d,f,g}]&/@pts,{b,c,d,e,f,g}][[1]]

line[l_List]:=Line[Append[l,l[[1]]]]

ln[i_,pts_]:=Module[{p,j=Mod[i+2,6]+1,k=Mod[i+3,6]+1},
p=LineLineIntersection[pts[[{i,i+1}]],pts[[{j,k}]]];
{Point[p],ExtendedLine[Append[pts[[{i,i+1}]],p]],
ExtendedLine[Append[pts[[{j,k}]],p]]}
]

pts=Table[Random[],{5},{2}];
pts6=Append[pts,{xx=Random[],Select[yy/.Solve[conic[pts,{xx,yy}],yy],Im[#]==0&][[1]]}];

ExtendedLine[l_]:=Module[{u=#/Sqrt[#.#]&[l[[2]]-l[[1]]]},
Line[{#[[1]]-.2u,#[[2]]+.2u}&[LongestLine[l]]]
]

Show[Graphics[ImplicitPlot[conic[pts,{x,y}],{x,-1.5,1.5},{y,-1.5,1.5},PlotPoints->70,Epilog->{PointSize[.03],
Rest/@(v=Table[ln[i,pts6],{i,3}]),Thickness[.007],
RGBColor[1,0,0],Point/@pts6,line[pts6],
RGBColor[0,0,1],ExtendedLine[#[[1,1]]&/@v],First/@v
},Axes->False,
DisplayFunction->Identity]],PlotRange->{{0,1.1},{.2,1.1}},DisplayFunction->$DisplayFunction]