楕円上のブリアンションの定理 - DyGeom.m on Mathematica+KETpic

<< ketpic6.m
<< DyGeom.m
g1 = グラフ[Sqrt[-x^2/4 + 1], {x, -2, 2}]
g2 = グラフ[-Sqrt[-x^2/4 + 1], {x, -2, 2}]
p1 = グラフ上の点[g1, -1.9]
p2 = グラフ上の点[g1, 0.2];
p3 = グラフ上の点[g1, 1.3];
p4 = グラフ上の点[g2, 1.8];
p5 = グラフ上の点[g2, 0.1];
p6 = グラフ上の点[g2, -1.4];
l1 = グラフの接線[g1, p1]; l2 = グラフの接線[g1, p2]; l3 = グラフの接線[g1, p3];
l4 = グラフの接線[g2, p4]; l5 = グラフの接線[g2, p5]; l6 = グラフの接線[g2, p6];
q1 = 交点[l1, l2]; q2 = 交点[l2, l3]; q3 = 交点[l3, l4];
q4 = 交点[l4, l5]; q5 = 交点[l5, l6]; q6 = 交点[l6, l1];
l2 = AddOption[l2, clipping -> {q1, q2}]
l3 = AddOption[l3, clipping -> {q2, q3}]
l4 = AddOption[l4, clipping -> {q3, q4}]
l5 = AddOption[l5, clipping -> {q4, q5}]
l6 = AddOption[l6, clipping -> {q5, q6}]
l1 = AddOption[l1, clipping -> {q6, q1}]
m1 = 線分[q1, q4]
m2 = 線分[q2, q5]
m3 = 線分[q3, q6]
r1 = 交点[m1, m2]
作図[g1, g2, l1, l2, l3, l4, l5, l6, q1, q2, q3, q4, q5, q6, m1, m2, m3, r1]

---

(* in English *)
<< ketpic6.m
<< DyGeom.m
g1 = FunctionGraph[Sqrt[-0.25*x^2 + 1], {x, -2, 2}]
g2 = FunctionGraph[-Sqrt[-0.25*x^2 + 1], {x, -2, 2}]
p1 = PointOnFunctionGraph[g1, -1.9];
p2 = PointOnFunctionGraph[g1, 0.2];
p3 = PointOnFunctionGraph[g1, 1.3];
p4 = PointOnFunctionGraph[g2, 1.8];
p5 = PointOnFunctionGraph[g2, 0.1];
p6 = PointOnFunctionGraph[g2, -1.4];
l1 = TangentLineOnGraph[g1, p1];
l2 = TangentLineOnGraph[g1, p2];
l3 = TangentLineOnGraph[g1, p3];
l4 = TangentLineOnGraph[g2, p4];
l5 = TangentLineOnGraph[g2, p5];
l6 = TangentLineOnGraph[g2, p6];
q1 = GeomIntersection[l1, l2];
q2 = GeomIntersection[l2, l3];
q3 = GeomIntersection[l3, l4];
q4 = GeomIntersection[l4, l5];
q5 = GeomIntersection[l5, l6];
q6 = GeomIntersection[l6, l1];
l2 = AddOption[l2, clipping -> {q1, q2}]
l3 = AddOption[l3, clipping -> {q2, q3}]
l4 = AddOption[l4, clipping -> {q3, q4}]
l5 = AddOption[l5, clipping -> {q4, q5}]
l6 = AddOption[l6, clipping -> {q5, q6}]
l1 = AddOption[l1, clipping -> {q6, q1}]
m1 = ConnectPoints[q1, q4, clipping -> {q1, q4}]
m2 = ConnectPoints[q2, q5, clipping -> {q2, q5}]
m3 = ConnectPoints[q3, q6, clipping -> {q3, q6}]
r1 = GeomIntersection[m1, m2]
DrawConstruction[g1, g2, l1, l2, l3, l4, l5, l6, q1, q2, q3, q4, q5, \
q6, m1, m2, m3, r1]

---