|

楼主 |
发表于 2023-4-14 11:47
|
显示全部楼层
本帖最后由 天山草 于 2023-4-14 22:49 编辑
运行结果:
程序代码:
- Clear["Global`*"];
- (*构图法:B点置于坐标原点,BC与横轴重合,C、D点的坐标为变量,D是内切圆与BC切点。内切圆半径为 1*)
- \!\(\*OverscriptBox[\(b\), \(_\)]\) = b = 0; \!\(\*OverscriptBox[\(d\), \(_\)]\) = d; \!\(\*OverscriptBox[\(c\), \(_\)]\) = c;
- a = ((d^2 - 1) (d - c) + 2 I d (d - c))/(1 - c d + d^2);
- \!\(\*OverscriptBox[\(a\), \(_\)]\) = ((d^2 - 1) (d - c) - 2 I d (d - c))/(1 - c d + d^2);
- f = (d (d + I))/(d - I); \!\(\*OverscriptBox[\(f\), \(_\)]\) = (d (d - I))/(d + I);
- e = ( c (d + 2 I) - d (d + I))/(c - d + I); \!\(\*OverscriptBox[\(e\), \(_\)]\) = ( d (d - I) - c (d - 2 I))/(-c + d + I);
- (*以上公式是此构图下的已知公式,直接引用而不再推导*)
- Print["D = ", d, ", E = ", e, ", F = ", f];
- RB = d; RC = c - d; RA2 = Simplify[(a - f) (\!\(\*OverscriptBox[\(a\), \(_\)]\) - \!\(\*OverscriptBox[\(f\), \(_\)]\))];(*RA的平方*) RA = -c/( 1 - c d + d^2); Print["RA = ", RA, ", RB = ", RB, ", RC = ", RC];(*三个圆的半径*)
- k[a_, b_] := (a - b)/(\!\(\*OverscriptBox[\(a\), \(_\)]\) - \!\(\*OverscriptBox[\(b\), \(_\)]\)); (*复斜率定义*)
- FourPoint[a_, b_, c_, d_] := ((\!\(\*OverscriptBox[\(c\), \(_\)]\) d - c \!\(\*OverscriptBox[\(d\), \(_\)]\)) (a - b) - (
- \!\(\*OverscriptBox[\(a\), \(_\)]\) b - a \!\(\*OverscriptBox[\(b\), \(_\)]\)) (c - d))/((a - b) (\!\(\*OverscriptBox[\(c\), \(_\)]\) -
- \!\(\*OverscriptBox[\(d\), \(_\)]\)) - (\!\(\*OverscriptBox[\(a\), \(_\)]\) - \!\(\*OverscriptBox[\(b\), \(_\)]\)) (c - d));
- \!\(\*OverscriptBox[\(FourPoint\), \(_\)]\)[a_, b_, c_, d_] := -(((c \!\(\*OverscriptBox[\(d\), \(_\)]\) - \!\(\*OverscriptBox[\(c\), \(_\)]\) d) (\!\(\*OverscriptBox[\(a\), \(_\)]\) - \!\(\*OverscriptBox[\(b\), \(_\)]\)) - ( a \!\(\*OverscriptBox[\(b\), \(_\)]\) -
- \!\(\*OverscriptBox[\(a\), \(_\)]\) b) (\!\(\*OverscriptBox[\(c\), \(_\)]\) - \!\(\*OverscriptBox[\(d\), \(_\)]\)))/((a - b) (
- \!\(\*OverscriptBox[\(c\), \(_\)]\) - \!\(\*OverscriptBox[\(d\), \(_\)]\)) - (\!\(\*OverscriptBox[\(a\), \(_\)]\) -
- \!\(\*OverscriptBox[\(b\), \(_\)]\)) (c - d)));
- r = Simplify@FourPoint[f, d, a, c]; \!\(\*OverscriptBox[\(r\), \(_\)]\) = Simplify@\!\(\*OverscriptBox[\(FourPoint\), \(_\)]\)[f, d, a, c]; p = Simplify@FourPoint[f, e, b, c]; \!\(\*OverscriptBox[\(p\), \(_\)]\) = p; q = Simplify@FourPoint[e, d, a, b];
- \!\(\*OverscriptBox[\(q\), \(_\)]\) = Simplify@\!\(\*OverscriptBox[\(FourPoint\), \(_\)]\)[e, d, a, b];
- Print["R = ", r, ", P = ", p, ", Q = ", q];
- W1 = {at, \!\(\*OverscriptBox[\(at\), \(_\)]\)} /. Simplify@Solve[{(p - at)/(\!\(\*OverscriptBox[\(p\), \(_\)]\) - \!\(\*OverscriptBox[\(at\), \(_\)]\)) == -((a - at)/(\!\(\*OverscriptBox[\(a\), \(_\)]\) - \!\(\*OverscriptBox[\(at\), \(_\)]\))), (p - a) (\!\(\*OverscriptBox[\(p\), \(_\)]\) - \!\(\*OverscriptBox[\(a\), \(_\)]\)) == (p - at) (\!\(\*OverscriptBox[\(p\), \(_\)]\) - \!\(\*OverscriptBox[\(at\), \(_\)]\)) + RA^2}, {at, \!\(\*OverscriptBox[\(at\), \(_\)]\)}] // Flatten;
- at = Part[W1, 1]; \!\(\*OverscriptBox[\(at\), \(_\)]\) = Part[W1, 2];
- W2 = {bt, \!\(\*OverscriptBox[\(bt\), \(_\)]\)} /. Simplify@Solve[{(r - bt)/(\!\(\*OverscriptBox[\(r\), \(_\)]\) -
- \!\(\*OverscriptBox[\(bt\), \(_\)]\)) == -((b - bt)/(\!\(\*OverscriptBox[\(b\), \(_\)]\) - \!\(\*OverscriptBox[\(bt\), \(_\)]\))), (r - b) (
- \!\(\*OverscriptBox[\(r\), \(_\)]\) - \!\(\*OverscriptBox[\(b\), \(_\)]\)) == (r - bt) (\!\(\*OverscriptBox[\(r\), \(_\)]\) -
- \!\(\*OverscriptBox[\(bt\), \(_\)]\)) + RB^2}, {bt, \!\(\*OverscriptBox[\(bt\), \(_\)]\)}] // Flatten ; bt = Part[W2, 3];
- \!\(\*OverscriptBox[\(bt\), \(_\)]\) = Part[W2, 4];
- W3 = {ct, \!\(\*OverscriptBox[\(ct\), \(_\)]\)} /. Simplify@Solve[{(q - ct)/(\!\(\*OverscriptBox[\(q\), \(_\)]\) -
- \!\(\*OverscriptBox[\(ct\), \(_\)]\)) == -((c - ct)/(\!\(\*OverscriptBox[\(c\), \(_\)]\) - \!\(\*OverscriptBox[\(ct\), \(_\)]\))), (q - c) (
- \!\(\*OverscriptBox[\(q\), \(_\)]\) - \!\(\*OverscriptBox[\(c\), \(_\)]\)) == (q - ct) (\!\(\*OverscriptBox[\(q\), \(_\)]\) -
- \!\(\*OverscriptBox[\(ct\), \(_\)]\)) + RC^2}, {ct, \!\(\*OverscriptBox[\(ct\), \(_\)]\)}] // Flatten ; ct = Part[W3, 3];
- \!\(\*OverscriptBox[\(ct\), \(_\)]\) = Part[W3, 4];
- Print["AT = ", at, ", BT = ", bt, ", CT = ", ct];(*三个切点的坐标*)
- WX[a_, b_, c_] := (a \!\(\*OverscriptBox[\(a\), \(_\)]\) (c - b) + b \!\(\*OverscriptBox[\(b\), \(_\)]\)(a - c) + c \!\(\*OverscriptBox[\(c\), \(_\)]\)(b - a) )/(\!\(\*OverscriptBox[\(a\), \(_\)]\)(c - b) + \!\(\*OverscriptBox[\(b\), \(_\)]\)(a - c) + \!\(\*OverscriptBox[\(c\), \(_\)]\)(b - a));
- \!\(\*OverscriptBox[\(WX\), \(_\)]\)[a_, b_, c_] := -((a \!\(\*OverscriptBox[\(a\), \(_\)]\)(\!\(\*OverscriptBox[\(c\), \(_\)]\) -
- \!\(\*OverscriptBox[\(b\), \(_\)]\)) + b \!\(\*OverscriptBox[\(b\), \(_\)]\)(\!\(\*OverscriptBox[\(a\), \(_\)]\) - \!\(\*OverscriptBox[\(c\), \(_\)]\)) + c \!\(\*OverscriptBox[\(c\), \(_\)]\)(\!\(\*OverscriptBox[\(b\), \(_\)]\) - \!\(\*OverscriptBox[\(a\), \(_\)]\)))/(
- \!\(\*OverscriptBox[\(a\), \(_\)]\)(c - b) + \!\(\*OverscriptBox[\(b\), \(_\)]\)(a - c) + \!\(\*OverscriptBox[\(c\), \(_\)]\)(b - a)));
- s = Simplify@WX[at, bt, ct];
- \!\(\*OverscriptBox[\(s\), \(_\)]\) = Simplify@\!\(\*OverscriptBox[\(WX\), \(_\)]\)[at, bt, ct];
- s = (d^2 (c - d - 1) (c (d - 2) - d^2 + d))/(d^4 + d^2 - c (2 d^2 - 2 d + 1) d + c^2 (d - 1)^2) +
- I (2 d (c - d) (c (d - 1) - d^2))/(d^4 + d^2 - c (2 d^2 - 2 d + 1) d + c^2 (d - 1)^2);
- Print["Soddy 圆的圆心坐标(实部+虚部) S = ", s];
- g = FullSimplify@FourPoint[f, ct, e, bt];
- \!\(\*OverscriptBox[\(g\), \(_\)]\) = FullSimplify@\!\(\*OverscriptBox[\(FourPoint\), \(_\)]\)[f, ct, e, bt];(*直线F-CT与E-BT的交点*)
- g1 = FullSimplify@FourPoint[f, ct, d, at]; \!\(\*OverscriptBox[\(g1\), \(_\)]\) = FullSimplify@\!\(\*OverscriptBox[\(FourPoint\), \(_\)]\)[f, ct, d, at]; (*直线F-CT与D-AT的交点*)
- Print["G = ", g, ", G1 = ", g1];
- Print["以下测试G点与G1点是否重合:"];
- Simplify[g == g1](*测试G点与G1点是否重合*)
复制代码 |
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|