找回密码
 欢迎注册
查看: 11586|回复: 37

[讨论] Mathematica为什么算不出最后的结论

[复制链接]
发表于 2021-9-28 22:47:58 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?欢迎注册

×
这是uk702在数学中国发出的问题,Mathematica7.0为什么算不出最后的结论?其它版本行吗?
等腰三角形与等边三角形1.gif

毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-9-29 12:08:57 | 显示全部楼层
不用复数也可以证明:

一个几何题的解析法证明.png
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-9-29 14:08:17 | 显示全部楼层
本帖最后由 TSC999 于 2021-9-29 14:10 编辑

完整的 mathematica 程序代码如下:

  1. Clear["Global`*"];
  2. XA = 0; YA = a; XB = -1; YB = 0; XC = 1; YC = 0;
  3. XF = 1/2;  YF = a/2;  
  4. xy = Solve[{y == (x + 1) Tan[\[Pi]/6], (y - a/2)/(x - 1/2) == 1/
  5.      a}, {x, y}];
  6. x = x /. xy; y = y /. xy;
  7. XE = x[[1]]; YE = y[[1]];
  8. Print["XE = ", XE];
  9. Print["YE = ", YE];
  10. AC = Simplify[Sqrt[(XA - XC)^2 + (YA - YC)^2]];
  11. AE = Simplify[Sqrt[(XA - XE)^2 + (YA - YE)^2]];
  12. EC = Simplify[Sqrt[(XE - XC)^2 + (YE - YC)^2]];
  13. Print["AC = ", AC];
  14. Print["AE = ", AE];
  15. Print["EC = ", EC];
  16. If[AC == AE == EC,
  17. Print["由于 AC=AE=EC,所以 \[EmptyUpTriangle]ACE 是正三角形。 "]]
复制代码


运行结果如下:

运行结果.png
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-9-29 17:16:14 | 显示全部楼层
楼主的 E 点坐标计算正确。为何下面就进行不下去了呢?
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2021-9-29 20:09:59 | 显示全部楼层
  1. Clear[a]
  2. (*a=8;a=5;a=4;*)a' = -a; u = 1 + \[Omega]; u' = 1/u; c = 1;
  3. \[Omega] = -(1/2) + Sqrt[3]/2 I;
  4. e = -a  \[Omega] - \[Omega]^2; e' = -a  /\[Omega] - 1/\[Omega]^2;
  5. Simplify[{(1 - u a)/(1 - u), (u + a)/(
  6.   u - 1), ((1 - u a)/(1 - u) + 1)/((u + a)/(u - 1) +
  7.    1), ((1 - u a)/(1 - u)) ((u + a)/(u - 1)), \[Omega], , e, e', (
  8.   c - a)/(c - e), (e + 1)/(e' + 1)}](*假设向量EC/向量EA=v*)
  9. Solve[((1 - v a)/(1 - v) + 1)/((v + a)/(v - 1) + 1) ==
  10.   1 + \[Omega], v]    (*\[Angle]EBC等于30\[Degree],EC直线的复斜率等于1+\[Omega]*)



  11. {{v -> (3 I + Sqrt[3] + I a - Sqrt[3] a)/(2 (Sqrt[3] + I a))}}

  12. {{v -> (3 I + Sqrt[3] + I a - Sqrt[3] a)/(2 (Sqrt[3] + I a))}}
  13. (3 I + Sqrt[3] + I a - Sqrt[3] a)/(
  14. 2 (Sqrt[3] + I a)) = (Sqrt[3] i (Sqrt[3] + I a) + Sqrt[3] + I a)/(
  15.   2 (Sqrt[3] + I a)) = 1/2 + (Sqrt[3]/2) I(*这项结论正确,手工计算*)
复制代码

图片中第一段使用坐标是对的,主要是这段为什么计算结果里会出现a?主题构图简单,复数没有优势,下面这题就明显了。

点评

没有用复数,做出了此题的半机器证明,因为其中许多化简是由人工协助机器完成的。程序见下页。  发表于 2021-10-4 20:39
用纯几何方法做,此题并不难。  发表于 2021-10-4 10:55
用解析几何方法和机器证明,加上人工化简,算出 DB:BC=两圆半径之比的平方。但是 MQ: QN 机器算很长时间也没有结果。 用具体数字计算可以验证这些结论。  发表于 2021-10-4 10:52
很好,看来老朋友做出来了  发表于 2021-10-3 20:54
① 这个比值等于两圆半径之比的平方。 ② 另外有 MN//EF。 ③ 如果 AB 的延长线交 EF 于 P 点,则这个比值也等于 EP: PF,即 BP 是 ∠EBF 的平分线。  发表于 2021-10-2 23:12
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-10-4 20:41:09 | 显示全部楼层
本帖最后由 TSC999 于 2021-10-4 20:53 编辑

证明比值等于圆半径之比的平方1.png

mathematica 程序及运行结果如下:

  1. Clear["Global`*"];
  2. XA = (R^2 - a^2 - 1)/(
  3. 2 a);  YA = Sqrt[-a^4 + 2 a^2 (R^2 + 1) - (R^2 - 1)^2]/(2 a);
  4. XB = (R^2 - a^2 - 1)/(
  5. 2 a);  YB = -(Sqrt[-a^4 + 2 a^2 (R^2 + 1) - (R^2 - 1)^2]/(2 a));
  6. XD = (a^4 - a^2 (2 R^2 + 3) + R^2 (R^2 - 1))/(
  7. 2 a); YD = ( (R^2 - a^2) Sqrt[-a^4 +
  8.    2 a^2 (R^2 + 1) - (R^2 - 1)^2])/(2 a);
  9. XC = (-a^4 + a^2 (R^2 + 2) + R^2 - 1)/(2 a R^2);  YC =
  10. 1/(2 a R^2) ((1 - a^2) Sqrt[-a^4 + 2 a^2 (R^2 + 1) - (R^2 - 1)^2]);
  11. XE = ( a^6 - a^4 (2 R^2 + 3) + a^2 (R^4 - R^2 + 3) + R^2 - 1)/(
  12. 2 a R^2); YE = (-a^8 + a^6 (3 R^2 + 4) - a^4 (3 R^4 + 4 R^2 + 6) +
  13.   a^2 (R^6 - R^2 + 4) - (R^2 - 1)^2)/(
  14. 2 a R^2 Sqrt[-a^4 + 2 a^2 (R^2 + 1) - (R^2 - 1)^2]);
  15. XF = (-a^6 + a^4 (3 R^2 + 2) - a^2 (3 R^4 + R^2 + 1) +
  16.   R^4 (R^2 - 1))/(2 a R^2); YF = (
  17. Sqrt[-a^4 +
  18.    2 a^2 (R^2 + 1) - (R^2 - 1)^2] (a^4 - a^2 (2 R^2 + 1) + R^4))/(
  19. 2 a R^2)   ;
  20. XM = (-a^6 + a^4 (2 R^2 + 1) + a^2 (-R^4 + 3 R^2 + 1) + R^2 - 1)/(
  21. 2 a (a^4 - 2 a^2 (R^2 + 1) + R^4 - R^2 + 1)); YM = (
  22. Sqrt[-a^4 +
  23.    2 a^2 (R^2 + 1) - (R^2 - 1)^2] (a^4 - a^2 (R^2 + 2) + 1))/(
  24. 2 a (a^4 - 2 a^2 (R^2 + 1) + R^4 - R^2 + 1));
  25. XN = -((a (a^2 - R^2 - 1) (a^6 - a^4 (3 R^2 + 2) +
  26.      a^2 (3 R^4 + R^2 + 1) - R^6 + R^4))/(
  27.   2 a^8 - a^6 (5 R^2 + 6) + 3 a^4 (R^4 + 2 R^2 + 2) +
  28.    a^2 (R^6 - R^4 - R^2 - 2) + (a^4 - a^2 (2 R^2 + 1) +
  29.       R^4) R^2(-a^2 + R^2 - 1) - R^8 +
  30.    R^6)); YN = ( (a^4 - a^2 (2 R^2 + 1) + R^4) Sqrt[-a^4 +
  31.    2 a^2 (R^2 + 1) - (R^2 - 1)^2])/(
  32. 2 a (a^4 - 2 a^2 (R^2 + 1) + R^4 - R^2 + 1));
  33. XQ = (R^2 - a^2 - 1)/(2 a); YQ = (
  34. Sqrt[-a^4 +
  35.    2 a^2 (R^2 + 1) - (R^2 - 1)^2] (a^4 (R^2 + 1) -
  36.     2 a^2 (R^4 + R^2 + 1) + R^6 + 1))/(
  37. 2 a (R^2 + 1) (a^4 - 2 a^2 (R^2 + 1) + R^4 - R^2 + 1));
  38. DB = Sqrt[(XD - XB)^2 + (YD - YB)^2]; BC = Sqrt[(XC - XB)^2 + (YC -
  39.     YB)^2];
  40. MQ = Sqrt[(XM - XQ)^2 + (YM - YQ)^2]; NQ = Sqrt[(XN - XQ)^2 + (YN -
  41.     YQ)^2];
  42. k1 = Simplify[DB/BC, a > 0 && R > 0]; k2 =
  43. Simplify[MQ/NQ, a > 0 && R > 0];
  44. Print["DB/BC = ", k1]; Print["MQ/NQ = ", k2];
  45. If[k1 == k2,
  46. Print["\!\(\*SuperscriptBox[\(由于二者之比都等于R\), \(2\)]\),所以DB/BC = \
  47. MQ/NQ"]]
复制代码


程序运行结果:

  1. DB/BC = R^2

  2. MQ/NQ = R^2

  3. 由于二者之比都等于R^2,所以DB/BC = MQ/NQ
复制代码

点评

试了你的代码,比复数还是复杂许多  发表于 2021-10-5 20:00
谢谢老师,增长了知识。  发表于 2021-10-5 19:54
游览器有毛病,我的也有这个问题,后来换了一个 360 极速游览器可解决。更简单的办法是:选中代码后用 Ctrl +C 复制,用 Ctrl +V 粘接。  发表于 2021-10-5 09:42
Ie浏览器复制不了代码  发表于 2021-10-4 22:18
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2021-10-4 22:11:57 | 显示全部楼层
本帖最后由 dlsh 于 2021-10-4 22:14 编辑

360截图20211004220454420.jpg
① 这个比值比的等于两圆半径之平方。 ② 另外有 MN//EF。 ③ 如果 AB 的延长线交 EF 于 P 点,则这个比值也等于 EP: PF,即 BP 是 ∠EBF 的平分线。
等于两圆半径之平方, BP 是 ∠EBF 的平分线两条结论正确,但是另外两条错误。证明 BP 平分 ∠EBF可能容易,其它可能比较难,请谈谈纯几何方法。



  1. \!\(\*OverscriptBox["o1", "_"]\) = o1 = 0;
  2. \!\(\*OverscriptBox["o2", "_"]\) = o2; b =
  3. \!\(\*OverscriptBox["a", "_"]\) = 1/a;
  4. \!\(\*OverscriptBox["b", "_"]\) = a;
  5. \!\(\*OverscriptBox["d", "_"]\) = 1/d;
  6. \!\(\*OverscriptBox["e", "_"]\) = 1/e;
  7. d = (a - o2)/(1 - a o2); c = a - a^2 o2 + o2;
  8. \!\(\*OverscriptBox["c", "_"]\) =
  9. \!\(\*OverscriptBox["a", "_"]\) -
  10. \!\(\*OverscriptBox["a", "_"]\) ^2 o2 + o2;(*根据复斜率手工计算得到*)
  11. e = (c - o2)/(b (
  12. \!\(\*OverscriptBox["b", "_"]\) - o2)); f = b d (
  13. \!\(\*OverscriptBox["b", "_"]\) - o2) + o2;
  14. \!\(\*OverscriptBox["f", "_"]\) =
  15. \!\(\*OverscriptBox["b", "_"]\)
  16. \!\(\*OverscriptBox["d", "_"]\) (b - o2) + o2;
  17. k[a_, b_] := (a - b)/(
  18. \!\(\*OverscriptBox["a", "_"]\) -
  19. \!\(\*OverscriptBox["b", "_"]\));
  20. \!\(\*OverscriptBox["k", "_"]\)[a_, b_] := 1/k[a, b];(*复斜率定义*)
  21. k[a_, b_, c_] := k[a, b]/k[c, b];(*e^(2IB)*)

  22. \!\(\*OverscriptBox["Jd", "_"]\)[k1_, a1_, k2_, a2_] := -((a1 - k1
  23. \!\(\*OverscriptBox["a1", "_"]\) - (a2 - k2
  24. \!\(\*OverscriptBox["a2", "_"]\)))/(
  25.   k1 - k2));(*复斜率等于k1,过点A1与复斜率等于k2,过点A2的直线交点*)
  26. Jd[k1_, a1_, k2_, a2_] := -((k2 (a1 - k1
  27. \!\(\*OverscriptBox["a1", "_"]\)) - k1 (a2 - k2
  28. \!\(\*OverscriptBox["a2", "_"]\)))/(k1 - k2));
  29. FourPoint[a_, b_, c_, d_] :=
  30.   Jd[k[a, b], a, k[c, d], d];(*过两对点A和B、C和D的直线交点*)

  31. \!\(\*OverscriptBox["FP", "_"]\)[a_, b_, c_, d_] :=
  32. \!\(\*OverscriptBox["Jd", "_"]\)[k[a, b], a, k[c, d], d];

  33. m = FourPoint[e, o1, a, d];
  34. \!\(\*OverscriptBox["m", "_"]\) =
  35. \!\(\*OverscriptBox["FP", "_"]\)[e, o1, a, d]; n =
  36. FourPoint[f, o2, a, c];
  37. \!\(\*OverscriptBox["n", "_"]\) =
  38. \!\(\*OverscriptBox["FP", "_"]\)[f, o2, a, c];
  39. q = FourPoint[m, n, a, b];
  40. \!\(\*OverscriptBox["q", "_"]\) =
  41. \!\(\*OverscriptBox["FP", "_"]\)[m, n, a, b]; p =
  42. FourPoint[e, f, a, b];
  43. \!\(\*OverscriptBox["p", "_"]\) =
  44. \!\(\*OverscriptBox["FP", "_"]\)[e, f, a, b];
  45. Simplify[{c, d, e, f, m, n}]
  46. Simplify[{0, q,
  47. \!\(\*OverscriptBox["q", "_"]\), p,
  48. \!\(\*OverscriptBox["p", "_"]\)}]

  49. Simplify[{1, b - d, b - c, , (b - d)/(b - c), q - m, q - n, , (
  50.   q - m)/(q - n)}](*验证比例*)
  51. Simplify[{2, m - n, e - f, , (m - n)/(e - f), k[m, n], k[e, f],
  52.   k[m, n] - k[e, f]}](*验证平行*)
  53. Simplify[{3, p - e, p - f, (p - e)/(p - f), , k[b, e],
  54.   k[b, f]}](*验证 PE/PF=MQ/NQ,BP 是 \[Angle]EBF 的平分线*)
复制代码
  1. {a + o2 - a^2 o2, (-a + o2)/(-1 + a o2), (a (a - a^2 o2))/(a - o2),
  2. o2 + (a - o2)^2/(a (1 - a o2)), (
  3. a^3 (-1 + a o2)^2)/(-a o2 - a^3 o2 + o2^2 + a^4 o2^2 -
  4.   a^2 (-1 + o2^2)), (
  5. a (2 o2^2 + a^3 o2^3 - a^2 (-1 + o2^2) - a o2 (2 + o2^2)))/(-a o2 -
  6.   a^3 o2 + o2^2 + a^4 o2^2 - a^2 (-1 + o2^2))}

  7. {0, (a^2 (-2 o2^2 + a^5 o2^3 - 2 a^2 (1 + o2^2) + a o2 (3 + o2^2) -
  8.     a^4 o2^2 (3 + o2^2) + a^3 o2 (3 + 2 o2^2)))/((-a o2 - a^3 o2 +
  9.     o2^2 + a^4 o2^2 - a^2 (-1 + o2^2)) (o2 + a^2 o2 -
  10.     a (2 + o2^2))), (-2 a^5 o2^2 + o2^3 - 2 a^3 (1 + o2^2) +
  11.   a^4 o2 (3 + o2^2) - a o2^2 (3 + o2^2) + a^2 o2 (3 + 2 o2^2))/(
  12. a (-a o2 - a^3 o2 + o2^2 + a^4 o2^2 - a^2 (-1 + o2^2)) (o2 + a^2 o2 -
  13.      a (2 + o2^2))), (-3 a^3 o2 + 4 a^2 o2^2 - 3 a o2^3 + o2^4 +
  14.   3 a^5 o2 (-1 + o2^2) + a^6 (o2^2 - o2^4) - a^4 (-2 + o2^4))/(
  15. a (o2 + a^2 o2 + a (-2 + o2^2)) (o2 + a^2 o2 -
  16.     a (1 + o2^2))), (-3 a^3 o2 + o2^2 + 4 a^4 o2^2 - 3 a^5 o2^3 -
  17.   o2^4 + a^6 o2^4 + 3 a o2 (-1 + o2^2) - a^2 (-2 + o2^4))/(
  18. a (o2 + a^2 o2 + a (-2 + o2^2)) (o2 + a^2 o2 - a (1 + o2^2)))}

  19. {1, (-1 + a^2)/(
  20. a (-1 + a o2)), ((-1 + a^2) (-1 + a o2))/a, Null, 1/(-1 + a o2)^2, (
  21. a^2 (-1 + a^2) o2 (2 o2 + a^2 o2 - a (2 + o2^2)))/((-a o2 - a^3 o2 +
  22.     o2^2 + a^4 o2^2 - a^2 (-1 + o2^2)) (o2 + a^2 o2 -
  23.     a (2 + o2^2))), (
  24. a (-1 + a^2) (a - o2)^2 o2 (2 - 3 a o2 + a^2 o2^2))/((-a o2 -
  25.     a^3 o2 + o2^2 + a^4 o2^2 - a^2 (-1 + o2^2)) (o2 + a^2 o2 -
  26.     a (2 + o2^2))), Null, a/((a - o2) (-1 + a o2))}

  27. {2, (a (-1 + a^2) o2 (2 o2 + a^2 o2 - a (2 + o2^2)))/(-a o2 - a^3 o2 +
  28.    o2^2 + a^4 o2^2 - a^2 (-1 + o2^2)), -o2 + (a - o2)^2/(
  29.   a (-1 + a o2)) + (a (a - a^2 o2))/(a - o2), Null, -((
  30.   a^2 (a - o2)^2 (-2 + a o2) (-1 + a o2))/((-2 a^2 + 2 a o2 + a^3 o2 -
  31.       o2^2) (-a o2 - a^3 o2 + o2^2 + a^4 o2^2 -
  32.      a^2 (-1 + o2^2)))), -((a^2 (2 o2 + a^2 o2 - a (2 + o2^2)))/(
  33.   o2 + 2 a^2 o2 - a (2 + o2^2))), (
  34. a (-2 a^2 + 2 a o2 + a^3 o2 - o2^2))/(
  35. 2 a - o2 - 2 a^2 o2 + a^3 o2^2), (
  36. a o2^2 (o2 + 3 a^2 o2 - 3 a^4 o2 - a^6 o2 - a (2 + o2^2) +
  37.     a^5 (2 + o2^2)))/((2 a - o2 - 2 a^2 o2 + a^3 o2^2) (o2 +
  38.     2 a^2 o2 - a (2 + o2^2)))}

  39. {3, ((-1 + a^2) o2 (-3 a^4 o2 + 3 a o2^2 + a^5 o2^2 - o2^3 -
  40.     a^2 o2 (4 + o2^2) + a^3 (2 + 3 o2^2)))/(
  41. a (o2 + a^2 o2 + a (-2 + o2^2)) (o2 + a^2 o2 -
  42.     a (1 + o2^2))), -(((-1 + a^2) o2 (-2 a^2 + 2 a o2 + a^3 o2 -
  43.      o2^2) (-1 + o2^2))/(-3 a o2 - 3 a^3 o2 + o2^2 + a^4 o2^2 +
  44.    a^2 (2 + 3 o2^2 - o2^4))), (a - o2 - a^2 o2)/(
  45. a (-1 + o2^2)), Null, (a (-1 + a o2))/(a - o2), (a - o2)/(
  46. a (-1 + a o2))}
复制代码

点评

你5楼的点评是MN//EF,有关角平分是对的。  发表于 2021-10-5 19:56
三条都是正确的。纯几何证明方法见下页。  发表于 2021-10-5 09:52
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-10-5 10:00:07 | 显示全部楼层
本帖最后由 TSC999 于 2021-10-5 13:24 编辑

证明.png

注: 这个证明是由【初等数学讨论】(http://kuing.orzweb.net/forumdisplay.php?fid=5 ) 的版主  kuing 做出的。

点评

整体相似?如何定义曲线相似  发表于 2021-10-5 20:22
谢谢,大致看了,感觉不容易。  发表于 2021-10-5 20:08
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-10-6 14:21:34 | 显示全部楼层
本帖最后由 TSC999 于 2021-10-6 15:28 编辑
dlsh 发表于 2021-10-4 22:11
① 这个比值比的等于两圆半径之平方。 ② 另外有 MN//EF。 ③ 如果 AB 的延长线交 EF 于 P 点,则这个比 ...


看了你的程序,代入具体数字验算,得不到需要的结论。不知哪个地方有毛病。
以你这个程序为基础,假定右边那个圆的半径为 R,两圆圆心之间的距离为 u。
但是在程序运行中有一个困难,就是目前 mathematica 对含有根式的复数公式的处理能力太差,只有靠人工参与协助电脑计算,但是人工干预多了,不但程序变长变复杂了,也不符合机器证明的要求了。

图.png

  1. Clear["Global`*"];

  2. \!\(\*OverscriptBox[\(o1\), \(_\)]\) = o1 = 0;
  3. \!\(\*OverscriptBox[\(o2\), \(_\)]\) = o2 = u;
  4. a = (-R^2 + u^2 + 1)/(2 u) +
  5.   I (Sqrt[-R^4 + 2 R^2 (u^2 + 1) - (u^2 - 1)^2])/(2 u);
  6. \!\(\*OverscriptBox[\(a\), \(_\)]\) = (-R^2 + u^2 + 1)/(2 u) -
  7.   I (Sqrt[-R^4 + 2 R^2 (u^2 + 1) - (u^2 - 1)^2])/(2 u);
  8. b =
  9. \!\(\*OverscriptBox[\(a\), \(_\)]\) ;
  10. \!\(\*OverscriptBox[\(b\), \(_\)]\) = a;
  11. c = Simplify[a - a^2 u + u];
  12. \!\(\*OverscriptBox[\(c\), \(_\)]\) = Simplify[
  13. \!\(\*OverscriptBox[\(a\), \(_\)]\) -
  14. \!\(\*OverscriptBox[\(a\), \(_\)]\) ^2 u + u];(*根据复斜率手工计算得到*)
  15. d = Simplify[(a - u)/(1 - a u)];
  16. e = Simplify[(c - u)/(b (
  17. \!\(\*OverscriptBox[\(b\), \(_\)]\) - u))]; f = Simplify[b d (
  18. \!\(\*OverscriptBox[\(b\), \(_\)]\) - u) + u];

  19. \!\(\*OverscriptBox[\(d\), \(_\)]\) = 1/d;
  20. \!\(\*OverscriptBox[\(e\), \(_\)]\) = 1/e;(*因为O1是单位圆之故*)

  21. \!\(\*OverscriptBox[\(f\), \(_\)]\) = Simplify[
  22. \!\(\*OverscriptBox[\(b\), \(_\)]\)  
  23. \!\(\*OverscriptBox[\(d\), \(_\)]\) (b - u) + u];
  24. Print["a = ", a]; Print["b = ", b];
  25. Print["c = ", c]; Print["d = ", d]; Print["e = ", e]; Print["f = ", f];

  26. Jd[a_, b_, c_,
  27.    d_] := ((c - d) (b Conjugate[a] - a Conjugate[b]) - (a -
  28.       b) (d Conjugate[c] - c Conjugate[d]))/((c - d) (Conjugate[a] -
  29.       Conjugate[b]) - (a - b) (Conjugate[c] - Conjugate[
  30.       d])); (* 直线 AB 与 CD 的交点复坐标 *)

  31. \!\(\*OverscriptBox[\(Jd\), \(_\)]\)[a_, b_, c_,
  32.   d_] := ((c - d) (b Conjugate[a] - a Conjugate[b] ) - (a -
  33.      b) (d Conjugate[c] - c Conjugate[d]))/( (Conjugate[c] -
  34.      Conjugate[d]) (a - b) - (Conjugate[a] - Conjugate[b] ) (c -
  35.      d));(*同时算出交点的共轭比没什么用,因为算出的交点坐标公式中仍会带有星号!不进一步化简就不能用! *)
  36. m = Simplify[Jd[a, d, e, o1], Element[{u, R}, Reals]];

  37. \!\(\*OverscriptBox[\(m\), \(_\)]\) = Simplify[
  38. \!\(\*OverscriptBox[\(Jd\), \(_\)]\)[a, d, e, o1],
  39.    Element[{u, R}, Reals]];
  40. Print["未化简的 m = ", m];(* 直接算出的 m 中含有带星的符号,公式不是最简,必须进一步化简才能用 *)
  41. m = m /. Conjugate[Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2]] ->
  42.    Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2];

  43. m = m /. Conjugate[((-2 u^2 -
  44.           I Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] - 1) R^2 +
  45.        u^2 (u^2 + I Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] -
  46.           1))] -> (u^4 - u^2 - 2 R^2 u^2 - R^2 -
  47.       I (u^2 - R^2) Sqrt[-R^4 + 2 R^2 (u^2 + 1) - (u^2 - 1)^2]);
  48. m = Simplify[m];
  49. Print["m = ", m];
  50. XM = Factor@
  51.     Together@
  52.      ComplexExpand@
  53.       Re[m /. Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] -> v] /.
  54.    v -> Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2];
  55. YM = Factor@
  56.     Together@
  57.      ComplexExpand@
  58.       Im[m /. Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] -> v] /.
  59.    v -> Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2];
  60. n = Simplify[Jd[a, c, f, o2], Element[{u, R}, Reals]];
  61. n = n /. Conjugate[Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2]] ->
  62.     Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2];
  63. n = n /. Conjugate[((2 u^2 +
  64.           I Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] + 1) R^2 +
  65.        u^2 (-u^2 - I Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] +
  66.           3))] ->
  67.     (3 u^2 - u^4 + 2 R^2 u^2 + R^2 -
  68.       I (R^2 - u^2) Sqrt[-R^4 + 2 R^2 (u^2 + 1) - (u^2 - 1)^2]);
  69. n = Simplify[n];
  70. Print["n = ", n];
  71. XN = Factor@
  72.     Together@
  73.      ComplexExpand@
  74.       Re[n /. Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] -> v] /.
  75.    v -> Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2];
  76. YN = Factor@
  77.     Together@
  78.      ComplexExpand@
  79.       Im[n /. Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] -> v] /.
  80.    v -> Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2];
  81. XD = Factor@
  82.     Together@
  83.      ComplexExpand@
  84.       Re[d /. Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] -> v] /.
  85.    v -> Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2];
  86. YD = Factor@
  87.     Together@
  88.      ComplexExpand@
  89.       Im[d /. Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] -> v] /.
  90.    v -> Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2];
  91. XC = Factor@
  92.     Together@
  93.      ComplexExpand@
  94.       Re[c /. Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] -> v] /.
  95.    v -> Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2];
  96. YC = Factor@
  97.     Together@
  98.      ComplexExpand@
  99.       Im[c /. Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2] -> v] /.
  100.    v -> Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2];
  101. XB = (-R^2 + u^2 + 1)/(
  102. 2 u); YB = -(Sqrt[-R^4 + 2 R^2 (u^2 + 1) - (u^2 - 1)^2]/(2 u));
  103. q = (-R^2 + u^2 + 1)/(2 u) +
  104.    I ((R^6 - 2 R^4 u^2 + R^2 u^2 (u^2 - 2) + (u^2 - 1)^2) Sqrt[-R^4 +
  105.       2 R^2 (u^2 + 1) - (u^2 - 1)^2])/(
  106.     2 (R^2 + 1) u (R^4 - R^2 (2 u^2 + 1) + (u^2 - 1)^2));
  107. XQ = (-R^2 + u^2 + 1)/(
  108. 2 u); YQ = ((R^6 - 2 R^4 u^2 +
  109.     R^2 u^2 (u^2 - 2) + (u^2 - 1)^2) Sqrt[-R^4 +
  110.    2 R^2 (u^2 + 1) - (u^2 - 1)^2])/(
  111. 2 (R^2 + 1) u (R^4 - R^2 (2 u^2 + 1) + (u^2 - 1)^2));
  112. Print["q = ", q];
  113. DB = Simplify[Sqrt[(XD - XB)^2 + (YD - YB)^2]]; BC =
  114. Simplify[Sqrt[(XC - XB)^2 + (YC - YB)^2]];
  115. MQ = Simplify[Sqrt[(XM - XQ)^2 + (YM - YQ)^2]]; NQ =
  116. Simplify[Sqrt[(XN - XQ)^2 + (YN - YQ)^2]];
  117. Print["DB = ", DB]; Print["BC = ", BC];
  118. Print["MQ = ", MQ]; Print["NQ = ", NQ];
  119. k1 = Simplify[DB/BC, a > 0 && R > 0]; k2 =
  120. Simplify[MQ/NQ, a > 0 && R > 0];
  121. Print["DB/BC = ", k1]; Print["MQ/NQ = ", k2];
  122. If[k1 == k2,
  123. Print["由于二者之比都等于 1/\!\(\*SuperscriptBox[\(R\), \(2\)]\),所以DB/BC = \
  124. MQ/NQ"]]
复制代码


程序运行结果:

  1. a = (-R^2+u^2+1)/(2 u)+(I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2])/(2 u)

  2. b = (-R^2+u^2+1)/(2 u)-(I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2])/(2 u)

  3. c = (-R^4+(2 u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]+1) R^2+u^2 (-u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]+3))/(2 u)

  4. d = (R^2+u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1)/(u (-R^2+u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1))

  5. e = -((R^4+(-2 u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1) R^2+u^2 (u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1))/(u (R^2-u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]+1)))

  6. f = (R^2+u^2+2 I u^2 Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1)/(u (-R^2+u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1))

  7. 未化简的 m = -((R^4+(-2 u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1) R^2+u^2 (u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1)) (((R^2+u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1) (-R^2+u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]^\[Conjugate]+1))/(2 u^2 (-R^2+u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1))+((R^2-u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1) (R^2+u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]^\[Conjugate]-1))/(2 u^2 (-R^2+u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]^\[Conjugate]-1))))/(u (R^2-u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]+1) (((R^4+(-2 u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1) R^2+u^2 (u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1)) (R^4-2 (u^2+1) R^2+(u^2-1)^2-(Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]^\[Conjugate])^2+2 I (R^2-u^2-1) Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]^\[Conjugate]))/(2 u^2 (-R^2+u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1) (-R^2+u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]^\[Conjugate]-1))+(((-R^2+u^2+1)/(2 u)+(I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2])/(2 u)-(R^2+u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1)/(u (-R^2+u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1))) (R^4+((-2 u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1) R^2+u^2 (u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1))^\[Conjugate]))/(u (R^2-u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]^\[Conjugate]+1))))

  8. m = ((-R^2+u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1) (R^4+(-2 u^2-I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1) R^2+u^2 (u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]-1)))/(4 u (R^4-(2 u^2+1) R^2+(u^2-1)^2))

  9. n = (u^2 R^4-(2 u^4+(I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]+3) u^2+1) R^2+(u^2-1)^2 (u^2+I Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2]+1))/(2 u (R^4-(2 u^2+1) R^2+(u^2-1)^2))

  10. q = (-R^2+u^2+1)/(2 u)+(I (R^6-2 u^2 R^4+u^2 (u^2-2) R^2+(u^2-1)^2) Sqrt[-R^4+2 (u^2+1) R^2-(u^2-1)^2])/(2 (R^2+1) u (R^4-(2 u^2+1) R^2+(u^2-1)^2))

  11. DB = Sqrt[-((R^4-2 (u^2+1) R^2+(u^2-1)^2)/(R^2 u^2))]

  12. BC = Sqrt[-((R^2 (R^4-2 (u^2+1) R^2+(u^2-1)^2))/u^2)]

  13. MQ = Sqrt[-((R^2 (2 R^6-(5 u^2+2) R^4+(4 u^4-6 u^2-2) R^2-(u^2-2) (u^2-1)^2))/((R^2+1)^2 (R^4-(2 u^2+1) R^2+(u^2-1)^2)^2))]

  14. NQ = Sqrt[-((R^6 (2 R^6-(5 u^2+2) R^4+(4 u^4-6 u^2-2) R^2-(u^2-2) (u^2-1)^2))/((R^2+1)^2 (R^4-(2 u^2+1) R^2+(u^2-1)^2)^2))]

  15. DB/BC = 1/R^2

  16. MQ/NQ = 1/R^2

  17. 由于二者之比都等于 1/R^2,所以DB/BC = MQ/NQ
复制代码


上面这个程序中,除了 Q 点的复数坐标人工化简失败,另用其它方法算出补上以外,其它点的坐标都是按楼主的程序算出的。

M  点和 N 点的复坐标,程序给出的结果十分复杂,通过人工疏导可以化简。如果不化简,后面的计算就进行不下去。

最后是关于线段长度的计算,用复坐标计算长度算不出来,也可能是算得非常慢,把复坐标换成直角坐标计算,瞬间就算出来了。
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2021-10-6 16:30:35 | 显示全部楼层
本帖最后由 TSC999 于 2021-10-6 17:32 编辑

用楼主那个程序,给 O2 圆半径赋值 R=1.138,两圆圆心距离 u=1.621,程序运行结果正确,即两个比例相等成立。但是不代入具体数字,最终需要的结果算不出来,各点坐标的表达式也比楼上程序复杂。这说明 mathematica 处理复数的能力比较差,这就不好办了。

  1. Clear["Global`*"];
  2. u = 1.621; R = 1.138;

  3. \!\(\*OverscriptBox[\(o1\), \(_\)]\) = o1 = 0; o2 = u;
  4. \!\(\*OverscriptBox[\(o2\), \(_\)]\) = u;
  5. a = (-R^2 + u^2 + 1)/(2 u) + (
  6.    I Sqrt[-R^4 + 2 (u^2 + 1) R^2 - (u^2 - 1)^2])/(2 u);
  7. b = (-R^2 + u^2 + 1)/(2 u) -
  8.    I (Sqrt[-R^4 + 2 R^2 (u^2 + 1) - (u^2 - 1)^2])/(2 u);

  9. \!\(\*OverscriptBox[\(a\), \(_\)]\) = b;
  10. \!\(\*OverscriptBox[\(b\), \(_\)]\) = a;
  11. c = Simplify[a - a^2 u + u];
  12. \!\(\*OverscriptBox[\(c\), \(_\)]\) = Simplify[
  13. \!\(\*OverscriptBox[\(a\), \(_\)]\) -
  14. \!\(\*OverscriptBox[\(a\), \(_\)]\) ^2 u + u]; (* 根据复斜率手工计算得到*)
  15. d = Simplify[(a - u)/(1 - a u)];   
  16. \!\(\*OverscriptBox[\(d\), \(_\)]\) = Simplify[(1 - a u)/(a - u)]; e =
  17.   Simplify[(c - u)/(b (a - u))];  
  18. \!\(\*OverscriptBox[\(e\), \(_\)]\) = Simplify[(b (a - u))/(c - u)];
  19. f = Simplify[b d (a - u) + u];  
  20. \!\(\*OverscriptBox[\(f\), \(_\)]\) =
  21. Simplify[(a (b - u) (1 - a u))/(a - u) + u];
  22. Print["a = ", a, ",  b = ", b, " ,  c = ", c, " ,  d = ", d];
  23. k[a_, b_] := (a - b)/(
  24. \!\(\*OverscriptBox[\(a\), \(_\)]\) -
  25. \!\(\*OverscriptBox[\(b\), \(_\)]\));

  26. \!\(\*OverscriptBox[\(k\), \(_\)]\)[a_, b_] := 1/k[a, b];(*复斜率定义*)
  27. k[a_, b_, c_] := k[a, b]/k[c, b];(*e^(2IB)*)

  28. \!\(\*OverscriptBox[\(Jd\), \(_\)]\)[k1_, a1_, k2_, a2_] := -((a1 - k1
  29. \!\(\*OverscriptBox[\(a1\), \(_\)]\) - (a2 - k2
  30. \!\(\*OverscriptBox[\(a2\), \(_\)]\)))/(  k1 - k2));
  31. (*复斜率等于k1,过点A1与复斜率等于k2,过点A2的直线交点*)
  32. Jd[k1_, a1_, k2_, a2_] := -((k2 (a1 - k1
  33. \!\(\*OverscriptBox[\(a1\), \(_\)]\)) - k1 (a2 - k2
  34. \!\(\*OverscriptBox[\(a2\), \(_\)]\)))/(k1 - k2));
  35. FourPoint[a_, b_, c_, d_] :=   
  36. Jd[k[a, b], a, k[c, d], d];(*过两对点A和B、C和D的直线交点*)

  37. \!\(\*OverscriptBox[\(FP\), \(_\)]\)[a_, b_, c_, d_] :=
  38. \!\(\*OverscriptBox[\(Jd\), \(_\)]\)[k[a, b], a, k[c, d], d];
  39. m = Simplify[FourPoint[e, o1, a, d]];  
  40. \!\(\*OverscriptBox[\(m\), \(_\)]\) = Simplify[
  41. \!\(\*OverscriptBox[\(FP\), \(_\)]\)[e, o1, a, d]];
  42. n = Simplify[FourPoint[f, o2, a, c]];  
  43. \!\(\*OverscriptBox[\(n\), \(_\)]\) = Simplify[
  44. \!\(\*OverscriptBox[\(FP\), \(_\)]\)[f, o2, a, c]];
  45. q = Simplify[FourPoint[m, n, a, b]];  
  46. \!\(\*OverscriptBox[\(q\), \(_\)]\) = Simplify[
  47. \!\(\*OverscriptBox[\(FP\), \(_\)]\)[m, n, a, b]];
  48. p = Simplify[FourPoint[e, f, a, b]];
  49. \!\(\*OverscriptBox[\(p\), \(_\)]\) = Simplify[
  50. \!\(\*OverscriptBox[\(FP\), \(_\)]\)[e, f, a, b]];
  51. Print["e = ", e, "  ,  f = ", f, "  ,  m = ", m, "  , n = ", n,
  52.   " , q = ", q];
  53. w1 = Simplify[Abs[ (q - m)/(q - n)]]
  54. w2 = Simplify[Abs[ (b - d)/(b - c)]]
  55. Simplify[w1 == w2]
复制代码


运行结果:

a = 0.719493 +0.694499 I,  b = 0.719493 -0.694499 I ,  c = 2.28321 -0.925488 I ,  d = -0.487966-0.872863 I
e = -0.889563-0.456813 I  ,  f = 2.6848 -0.404188 I  ,  m = 0.305211 +0.156734 I  , n = 1.25601 +0.138678 I , q = 0.719493 +0.148866 I
0.772175
0.772175
True

点评

我的构图方式是先做O1和O2,再做A,这样就不会产生根号,而你是用半径求交点,自然产生根号,如果你用坐标,利用A和B都在两个圆上,最后应该可以消去,比如出现ax^2+ay^2,就可以用1代替,不过我不懂程序如何实现  发表于 2021-10-6 20:32
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
您需要登录后才可以回帖 登录 | 欢迎注册

本版积分规则

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

GMT+8, 2024-4-20 13:40 , Processed in 0.050647 second(s), 20 queries .

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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