找回密码
 欢迎注册
楼主: mathe

[讨论] 六心共曲线

[复制链接]
发表于 2021-5-25 23:45:10 | 显示全部楼层
Geogebra有一个命令TriangleCenter(<Point>,<Point>,<Point>,<number>), 可以直接作出三角形的各种中心。
我把 number设为一个增量为1的滑动条,作图验证了number=1~100的情况,结果:
只有number=3时,O不必是相应的心,为任意点都行。
number=1,2,3,4分别为内心、重心、外心、垂心。

对于O为相应的心,除了number=1,2,3可以,貌似number=10也行,但不知这是个什么心。
number=10只是目测貌似,用IsInRegion()判定时,有显示False的点。
number=13十分接近,高度疑似,但应该不是,在三角形很钝的情况下有一点不易察觉的偏离。用IsInRegion()判定时,很容易显示False。

搜了下,number=10 是三角形的Spieker心, number=13是三角形的Fermat点
根据链接得知https://en.wikipedia.org/wiki/Encyclopedia_of_Triangle_Centers 得知,
三角形各中心百科全书(Encyclopedia of Triangle Centers,ETC)是一个在线的列表,收录了上万和三角形相关的三角形中心。
网站现正由伊凡斯维尔大学的数学教授克拉克·金伯林维护。截至2017年8月20日,此列表已一共收录有14143个三角形中心[1]。 https://faculty.evansville.edu/ck6/encyclopedia/ETC.html
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-5-26 00:22:00 | 显示全部楼层
找到了一个合适的简化计算路径,证毕。
共圆锥曲线证明2.cdf (43.24 KB, 下载次数: 9)

点评

一般适合于 代码里面 有交互的模块  发表于 2021-5-26 08:08
Wolfram Computable Document Format (CDF)  发表于 2021-5-26 08:07
cdf是Mathematica程序发布后的二进制文件.  发表于 2021-5-26 08:07
能介绍一下吗?cdf文件我这边无法解析  发表于 2021-5-26 05:32
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-5-26 08:06:04 | 显示全部楼层
creasson 发表于 2021-5-26 00:22
找到了一个合适的简化计算路径,证毕。

楼上的cdf里的代码贴出来如下:
  1. Clear["Global`*"];
  2. (*设点*)
  3. (*Z[u_,v_]:=-(((-\[ImaginaryI]-\[ImaginaryI] p+p u) (-\
  4. \[ImaginaryI]-\[ImaginaryI] p+p v))/(1+p+p u v));
  5. PO = 1/2;*)
  6. Z[u_, v_] := -(((-I + u) (-I + v))/(1 + u v));
  7. PO = 0;
  8. PA = Z[a, b]; PB = Z[b, c]; PC = Z[c, d]; PD = Z[d, e]; PE =
  9. Z[e, f]; PF = Z[f, a];

  10. (*AOD, BOE, COF三点共线*)

  11. linst1 =
  12.   Factor[
  13.    ComplexExpand[
  14.     Im[PA * Conjugate[PO] + PO * Conjugate[PD] + PD * Conjugate[PA]]]];
  15. linst2 =
  16.   Factor[
  17.    ComplexExpand[
  18.     Im[PB * Conjugate[PO] + PO * Conjugate[PE] + PE * Conjugate[PB]]]];
  19. linst3 =
  20.   Factor[
  21.    ComplexExpand[
  22.     Im[PC * Conjugate[PO] + PO * Conjugate[PF] + PF * Conjugate[PC]]]];
  23. (*这三式不是独立的,任意两式可推出第三式,可解出e,f*)

  24. efsolve =
  25.   Solve[{linst1, linst2, linst3} == 0, {e, f}] // Factor // Flatten;
  26. (*设点G,H,I,J,K,L*)
  27. (*Q[\[Zeta]_,\[Eta]_]:=-((-1-2 p-p^2+p^2 \[Zeta]-\
  28. \[ImaginaryI] p \[Eta]-\[ImaginaryI] p^2 \[Eta])/(1+p+p \[Zeta]));*)

  29. Q[\[Zeta]_, \[Eta]_] := -((-1 + \[Zeta] - I \[Eta])/(1 + \[Zeta]));
  30. PG = Q[G1, G2]; PH = Q[H1, H2]; PI = Q[I1, I2]; PJ = Q[J1, J2]; PK =
  31. Q[K1, K2]; PL = Q[L1, L2];
  32. (*KOH,LOI,GOJ共线*)

  33. linst4 =
  34.   Factor[
  35.    ComplexExpand[
  36.     Im[PK * Conjugate[PO] + PO * Conjugate[PH] + PH * Conjugate[PK]]]];
  37. linst5 =
  38.   Factor[
  39.    ComplexExpand[
  40.     Im[PL * Conjugate[PO] + PO * Conjugate[PI] + PI * Conjugate[PL]]]];
  41. linst6 =
  42.   Factor[
  43.    ComplexExpand[
  44.     Im[PG * Conjugate[PO] + PO * Conjugate[PJ] + PJ * Conjugate[PG]]]];
  45. (*可解出J2,K2,L2*)

  46. JKLsolve =
  47.   Solve[{linst4, linst5, linst6} == 0, {J2, K2, L2}] // Factor //
  48.    Flatten;
  49. (*角度相等*)
  50. angst1 =
  51.   Factor[ComplexExpand[Im[((PG - PC)*(PH - PC))/(PO - PC)^2]]] //
  52.    Numerator;
  53. angst2 =
  54.   Factor[ComplexExpand[Im[((PH - PD)*(PI - PD))/(PO - PD)^2]]] //
  55.    Numerator;
  56. angst3 =
  57.   Factor[ComplexExpand[Im[((PI - PE)*(PJ - PE))/(PO - PE)^2]]] //
  58.    Numerator;
  59. angst4 =
  60.   Factor[ComplexExpand[Im[((PJ - PF)*(PK - PF))/(PO - PF)^2]]] //
  61.    Numerator;
  62. angst5 =
  63.   Factor[ComplexExpand[Im[((PK - PA)*(PL - PA))/(PO - PA)^2]]] //
  64.    Numerator;
  65. angst6 =
  66.   Factor[ComplexExpand[Im[((PL - PB)*(PG - PB))/(PO - PB)^2]]] //
  67.    Numerator;
  68. angsts =
  69.   FactorList[#][[-1]][[1]] & /[url=home.php?mod=space&uid=6175]@[/url] {angst1, angst2, angst3, angst4,
  70.     angst5, angst6};
  71. (*代入前述关系化简*)
  72. solved = Flatten[{efsolve, JKLsolve}];
  73. angsts = Factor[angsts /. solved] // Numerator;
  74. angsts = FactorList[#][[-1]][[1]] & /@ angsts;
  75. (*GHIJKL六点共圆锥曲线*)

  76. ReIms = Factor[ComplexExpand[ReIm[{PG, PH, PI, PJ, PK, PL}]]];
  77. ReIms = (ReIms /. solved) // Factor;
  78. matrix = {#[[1]]^2, #[[1]]*#[[2]], #[[2]]^2, #[[1]], #[[2]], 1} & /@
  79.    ReIms;
  80. conicst = Det[matrix] // Factor // Numerator;
  81. conicst = FactorList[conicst][[-1]][[1]];
  82. conicst = Factor[conicst /. solved] // Numerator;
  83. (*GroebnerBasis[Flatten[{angsts,conicst}],{I2,H1,H2,J1,K1,L1}]*)
  84. \
  85. (*各变量的幂次*)

  86. Exponent[#, {G1, G2, H1, H2, I1, I2, J1, J2, K1, K2, L1,
  87.     L2}] & /@ angsts
  88. (*消元求解*)
  89. (*消去L1*)

  90. angst5 =
  91.   SubresultantPolynomialRemainders[angsts[[6]], angsts[[5]], L1][[-1]];
  92. angst5 = FactorList[angst5][[-1]][[1]];
  93. (*消去K1*)
  94. angst4 =
  95.   SubresultantPolynomialRemainders[angst5, angsts[[4]], K1][[-1]];
  96. angst4 = FactorList[angst4][[-1]][[1]];
  97. (*消去J1*)
  98. angst3 =
  99.   SubresultantPolynomialRemainders[angst4, angsts[[3]], J1][[-1]];
  100. angst3 = FactorList[angst3][[-1]][[1]];
  101. (*消去H2*)
  102. angst2 =
  103.   SubresultantPolynomialRemainders[angst3, angsts[[2]], H2][[-1]];
  104. angst2 = FactorList[angst2][[-1]][[1]];
  105. angst1 =
  106.   SubresultantPolynomialRemainders[angsts[[2]], angsts[[1]], H2][[-1]];
  107. angst1 = FactorList[angst1][[-1]][[1]];
  108. (*消去H1, 有两个有效因式, 取最后一个因式即可*)

  109. solve1 = SubresultantPolynomialRemainders[angst2, angst1, H1][[-1]];
  110. solve1 = FactorList[solve1][[-1]][[1]];  (*G1,G2,I1,I2*)
  111. (*回代消元*)

  112. solve2 = SubresultantPolynomialRemainders[angst1, solve1, I2][[-1]];
  113. solve2 = FactorList[solve2][[-1]][[1]];  (*G1,G2,I1,H1*)

  114. solve3 = SubresultantPolynomialRemainders[angst3, solve1, I2][[-1]];
  115. solve3 = FactorList[solve3][[-1]][[1]];  
  116. solve3 = SubresultantPolynomialRemainders[solve3, solve2, H1][[-1]];
  117. solve3 =
  118.   FactorList[solve3][[-1]][[
  119.    1]];  (*G1,G2,I1,H2*)
  120. (*solve4= \
  121. SubresultantPolynomialRemainders[angsts[[3]], solve1, I2][[-1]];
  122. solve4 = FactorList[solve4][[-1]][[1]];  (*G1,G2,I1,J1*)
  123. solve5 = \
  124. SubresultantPolynomialRemainders[angsts[[4]],  solve2, H1][[-1]];
  125. solve5 = FactorList[solve5][[-1]][[1]];
  126. solve5 = SubresultantPolynomialRemainders[solve5,  solve3, H2][[-1]];
  127. solve5 = FactorList[solve5][[-1]][[1]];
  128. solve5 = SubresultantPolynomialRemainders[solve5,  solve4, J1][[-1]];
  129. solve5 = FactorList[solve5][[-1]][[1]];  (*G1,G2,I1,K1*)
  130. solve6  = \
  131. SubresultantPolynomialRemainders[angsts[[6]],  solve1, I2][[-1]];
  132. solve6= FactorList[solve6][[-1]][[1]];  (*G1,G2,I1,L1*)*)
  133. (*共圆锥条件检验*)

  134. check = SubresultantPolynomialRemainders[conicst,  angsts[[1]],
  135.     I2][[-1]];
  136. check =  FactorList[check][[-1]][[1]];
  137. check = SubresultantPolynomialRemainders[check,  solve2, H1][[-1]];
  138. check =  FactorList[check][[-1]][[1]];
  139. PolynomialGCD[check, solve3]
  140. (*存在公因式则表明conicst在以上条件等式下是等于0的*)
复制代码
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-5-26 09:05:53 | 显示全部楼层
hujunhua 发表于 2021-5-23 17:35
上面的作图命令得一行行地拷贝,要是Geogebra能够整段地拷贝代码就好了。

这是一个很好的问题, 我查了下文档.文档说执行Geogebra命令的方式有四种. https://wiki.geogebra.org/en/Scripting
其中直接执行文件这种好像得是JavaScript脚本.

纯粹的GGBScript 命令,得通过交互控件触发.
都不完美,
没办法,我随便新建了一个Button 控件,然后设置 Button被点击的事件的脚本(On Click),黏贴如下内容,然后退出设置的状态, 点击按钮,都执行成功了.
  1. A=(2,3);
  2. B=(4,-4);
  3. C=(-1,1);
  4. sn=Slider(1,100,1);
  5. P=TriangleCenter(A,B,C,sn);
  6. a=Segment(B,C);
  7. b=Segment(C,A);
  8. c=Segment(A,B);
  9. D=Intersect(a,Line(A,P));
  10. E=Intersect(b,Line(B,P));
  11. F=Intersect(c,Line(C,P));
  12. G=TriangleCenter(P,A,E,sn);
  13. H=TriangleCenter(P,A,F,sn);
  14. I=TriangleCenter(P,B,F,sn);
  15. J=TriangleCenter(P,B,D,sn);
  16. K=TriangleCenter(P,C,D,sn);
  17. L=TriangleCenter(P,C,E,sn);
  18. conic5=Conic(G,H,I,J,K);
  19. tf=IsInRegion(L,conic5);
复制代码


export.ggb

13.09 KB, 下载次数: 5, 下载积分: 金币 -1 枚, 经验 1 点, 下载 1 次

毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-5-26 12:04:58 | 显示全部楼层
wayne 发表于 2021-5-26 09:05
这是一个很好的问题, 我查了下文档.文档说执行Geogebra命令的方式有四种. https://wiki.geogebra.org/en/ ...

在线试了一下,果然可以。
这就不错了。
@mathe可以试一下了,看看number=10,13是不是真的行。
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2021-5-26 12:35:10 来自手机 | 显示全部楼层
fermat点应该是退化情况
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-6-1 22:11:10 | 显示全部楼层
对于三角形\(ABC\)的内心\(I\)将原三角形分成6个三角形\(AIE,AIF,BIF,BID,BID,CID,CIE\),(其中\(D,E,F\)分别为\(AI,BI,CI\)延长线交对边的点)且这6个小三角形的内心分别设为\(I1,I2,I3,I4,I5,I6\)
为了便于分析与计算,我们将\(B\)点设为原点\(O,C\)点位于\(X\)正半轴上,并设

\(A[x1,y1],B[x2,y2],C[x3,y3],D[x11,y11],E[x12,y12],F[x13,y13],I[x0,y0],I1[x21,y21],I2[x22,y22],I3[x23,y23],I4[x24,y24],I5[x25,y25],I6[x26,y26]\)

\(AB=c,AC=b,BC=a,AD=t1,BE=t2,CF=t3,BD=a11,DC=a12,CE=b11,AE=b12,AF=c11,BF=c12\)

我们可以得到:

\(x1=\frac{a^2-b^2+c^2}{2a},y1=\frac{2s}{a},x2=0,y2=0,x3=a,y3=0,x0=\frac{a-b+c}{2},y0=\frac{2s}{a+b+c},x11=\frac{ac}{b+c},y11=0,x12=\frac{(a+c)^2-b^2}{2(a+c)},y12=\frac{2s}{a+c}

x13=\frac{a^2-b^2+c^2}{2(a+b)},y13=\frac{2s}{a+b}\)

\(a11=\frac{ac}{b+c},a12=\frac{ab}{b+c},b11=\frac{ab}{a+c},b12=\frac{bc}{a+c},c11=\frac{bc}{a+b},c12=\frac{ac}{a+b},a1=\frac{t1(b+c)}{a+b+c},a2=\frac{at1}{a+b+c},b1=\frac{(a+c)t2}{a+b+c},

b2=\frac{bt2}{a+b+c},c1=\frac{(a+b)t3}{a+b+c},c2=\frac{ct3}{a+b+c}\)

\(x21=\frac{a1x12 + b12x0 + b2x1}{b2 + b12 + a1}, y21=\frac{a1y12 + b12y0 + b2y1}{b2 + b12 + a1}, x22=\frac{a1x13 + c11x0 + c2x1}{c2 + c11 + a1}, y22=\frac{a1y13 + c11y0 + c2y1}{c2 + c11 + a1}, x23=\frac{b1x13 + c12x0 + c2x2}{c2 + c12 + b1}, y23=\frac{b1y13 + c12y0 + c2y2}{c2 + c12 + b1}

, x24=\frac{a11x0 + a2x2 + b1x11}{a2 + a11 + b1}, y24 =\frac{a11y0 + a2y2 + b1y11}{a2 + a11 + b1}, x25=\frac{a12x0 + a2x3 + c1x11}{a2 + a12 + c1}, y25=\frac{a12y0 + a2y3 + c1y11}{a2 + a12 + c1}, x26=\frac{b11x0 + b2x3 + c1x12}{b2 + b11 + c1}, y26=\frac{b11y0 + b2y3 + c1y12}{b2 + b11 + c1}\)

\(t1=\frac{\sqrt{bc(a+b+c)(-a+b+c)}}{b+c},t2=\frac{\sqrt{ac(a+b+c)(a-b+c)}}{a+c},t3=\frac{\sqrt{ab(a+b+c)(a+b-c)}}{a+b},s=\frac{\sqrt{2a^2b^2+2a^2c^2+2b^2c^2-a^4-b^4-c^4}}{4}\)

\(I1,I2,I3,I4,I5,I6\)选较简单的后5个点坐标构成椭圆曲线

\[\det{\left(
\begin{array}{cccccc}
x^2& xy& y^2& x&y,&1\\
x22^2&x22y22&y22^2&x22&y22&1\\
x23^2&x23y23&y23^2&x23&y23&1\\
x24^2&x24y24&y24^2&x24&y24&1\\
x25^2&x25y25&y25^2&x25&y25&1\\
x26^2&x26y26&y26^2&x26&y26&1\\
\end{array}
\right) }=0\]

例如:取\({a=5,b=4,c=3}\)

得到

\(a = 5, a1=\sqrt{2}, a11 = \frac{15}{7}, a12 =\frac{20}{7}, a2 = \frac{5\sqrt{2}}{7}, b = 4, b1 = \sqrt{5}, b11=\frac{5}{2}, b12=\frac{3}{2}, b2=\frac{\sqrt{5}}{2}, c = 3, c1 =\sqrt{10}, c11=\frac{4}{3}, c12=\frac{5}{3}, c2 =\sqrt{10}{3}, s = 6, t1=\frac{12\sqrt{2}}{7}, t2=\frac{3\sqrt{5}}{2}, t3=\frac{4\sqrt{10}}{3}, x0 = 2, x1 =\frac{9}{5}, x11=\frac{15}{7}, x12 = 3, x13 = 1, x2 = 0, x3 = 5, y0 = 1, y1=\frac{12}{5}, y11 = 0, y12 =\frac{3}{2}, y13 =\frac{4}{3}, y2 = 0, y3 = 0\)

\(x21 =\frac{2880 + 2880\sqrt{2}+ 864\sqrt{5}}{10(144 + 96\sqrt{2}+ 48\sqrt{5})}, x22 =\frac{2880 + 1080\sqrt{2}+ 648\sqrt{10}}{10(144 + 108\sqrt{2}+ 36\sqrt{10})}, x23 =\frac{720 + 216\sqrt{5}}{2(180 + 108\sqrt{5}+ 36\sqrt{10})}, x24 = \frac{15(48 + 24\sqrt{5})}{2(180 + 60\sqrt{2}+ 84\sqrt{5})}, x25 =\frac{5(192 + 120\sqrt{2}+ 72\sqrt{10})}{2(240 + 60\sqrt{2}+ 84\sqrt{10})}, x26 =\frac{960 + 576\sqrt{10}+ 480\sqrt{5}}{2(240 + 96\sqrt{10} + 48\sqrt{5})}, y21 = \frac{12(60 + 60\sqrt{2}+ 48\sqrt{5}}{5(144 + 96\sqrt{2}+ 48\sqrt{5})}, y22 =\frac{12(60 + 60\sqrt{2}+ 36\sqrt{10})}{5(144 + 108\sqrt{2}+ 36\sqrt{10})}, y23 = \frac{12(15 + 12\sqrt{5})}{180 + 108\sqrt{5} + 36\sqrt{10}}, y24 =\frac{180}{180 + 60\sqrt{2}+ 84\sqrt{5}}, y25 = \frac{240}{240 + 60\sqrt{2}+ 84\sqrt{10}}, y26 =\frac{12(20 + 12\sqrt{10})}{240 + 96\sqrt{10}+ 48\sqrt{5}}\)

椭圆曲线方程:

\((465865600000\sqrt{10}+ 657851200000\sqrt{5}+ 1038608000000\sqrt{2}+ 1477336000000)x^2 + ((43001600000\sqrt{10}+ 97088000000\sqrt{2}+ 63683200000\sqrt{5}+ 136976000000)y - 1952544000000\sqrt{10} - 4351680000000\sqrt{2}- 2757312000000\sqrt{5} - 6189600000000)x + (1024374400000\sqrt{10}+ 2294192000000\sqrt{2}+ 1448708800000\sqrt{5}+ 3245704000000)y^2 + (-2063712000000\sqrt{10}- 4633440000000\sqrt{2}- 2924256000000\sqrt{5}- 6549600000000)y + 8231400000000 + 5799600000000\sqrt{2}+ 2597040000000\sqrt{10} + 3668760000000\sqrt{5}=0\)


若消元可以得到:(一般表达式见附件,只含\(a,b,c,x,y\))

F1:   \(121186279x^8 - 168512396x^7y - 108228692x^6y^2 - 65161548x^5y^3 - 402431070x^4y^4 + 131013868x^3y^5 - 82188452x^2y^6 + 7291116xy^7 + 21119y^8 - 2264732500x^7 + 2182105400x^6y + 1544825300x^5y^2 - 917671000x^4y^3 + 3749646500x^3y^4 - 1667779000x^2y^5 + 425714300xy^6 - 16143400y^7 + 16821693700x^6 - 9733579100x^5y - 8472300500x^4y^2 + 10502577000x^3y^3 - 14462454500x^2y^4 + 5397472900xy^5 - 542302700y^6 - 63619801500x^5 + 17096885000x^4y + 23690115000x^3y^2 - 31225170000x^2y^3 + 25547692500xy^4 - 5204323000y^5 + 127737391250x^4 - 2691082500x^3y - 22808947500x^2y^2 + 31330282500xy^3 - 16654783750y^4 - 118412287500x^3 - 16203975000x^2y - 28204387500xy^2 - 4653675000y^3 + 3679312500x^2 - 16931812500xy + 51136312500y^2 + 68588437500x + 39639375000y - 30406640625=0\)

F2:   \(41659039x^8 - 69730684x^7y + 286833508x^6y^2 - 37209612x^5y^3 + 386084730x^4y^4 + 219518012x^3y^5 - 146455292x^2y^6 - 15692916xy^7 + 11868239y^8 - 601730380x^7 - 72003080x^6y - 3572639620x^5y^2 - 2078162600x^4y^3 - 4549171300x^3y^4 - 59095640x^2y^5 + 610175060xy^6 + 7908040y^7 + 4063741900x^6 + 7154965700x^5y + 22172801500x^4y^2 + 21578181000x^3y^3 + 13495178500x^2y^4 - 2238922300xy^5 - 889337900y^6 - 17105332500x^5 - 48172625000x^4y - 83709675000x^3y^2 - 67073850000x^2y^3 - 11779462500xy^4 + 3633115000y^5 + 48826666250x^4 + 150796807500x^3y + 176933227500x^2y^2 + 77586142500xy^3 + 688216250y^4 - 94309912500x^3 - 252919275000x^2y - 180009262500xy^2 - 29643825000y^3 + 116389687500x^2 + 215322187500xy + 68470312500y^2 - 81042187500x - 72309375000y + 23762109375=0\)

画图得到:

1.jpg

绿色曲线为F2,其中有部分与红色椭圆曲线重合

2.jpg

三角形6内心曲线.rar

1014.51 KB, 下载次数: 2, 下载积分: 金币 -1 枚, 经验 1 点, 下载 1 次

毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
您需要登录后才可以回帖 登录 | 欢迎注册

本版积分规则

小黑屋|手机版|数学研发网 ( 苏ICP备07505100号 )

GMT+8, 2024-11-21 21:12 , Processed in 0.027563 second(s), 19 queries .

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表