47309 人算不如機算──電腦輔助數學探索兩例

\begin{align*} &\hskip 15pt 2 S_{\triangle GEB}=EB\cdot (GL-BK)=EB\cdot (AC\cdot\sin\angle BAC+BC\cdot\cos\angle ABC),\\ &\hskip -20pt 2S_{\triangle DBC}=2S_{\triangle DEC}-2S_{\triangle DEB}-2S_{\triangle EBC}\\ &\hskip 20pt =DE\cdot(EB+KC)-DE^2-EB\cdot BC\cdot\sin\angle EBC\\ &\hskip 20pt =DE\cdot AC\cdot\sin\angle BAC+EB\cdot BC\cdot\cos\angle ABC,\ \hbox{所以}\ S_{\triangle GEB}=S_{\triangle DBC}. \end{align*}

$\dfrac{3A\!+\!B\!+\!C}{5}\!=\!\dfrac 25\,\dfrac{B\!+\!C}{2}\!+\!\Big(1\!-\!\dfrac 25\Big)A\!=\!\dfrac 45\,\dfrac{3A\!+\!C}{4}\!+\!\Big(1\!-\!\dfrac 45\Big)B\!=\!\dfrac 25\,\dfrac{A\!+\!C}{2}\!+\!\Big(1\!-\!\dfrac 25\Big) \dfrac{2A\!+\!B}{3}$,

$\dfrac{A\!+\!2B\!+\!3C}{6}\!=\!\dfrac 23\,\dfrac{A\!+\!3C}{4}\!+\!\Big(1\!-\!\dfrac 23\Big)B\!=\!\dfrac 23\,\dfrac{B\!+\!C}{2}\!+\!\Big(1\!-\!\dfrac 23\Big) \dfrac{A\!+\!C}{2}\!=\!\dfrac 12C\!+\!\Big(1\!-\!\dfrac 12\Big)\dfrac{A\!+\!2B}{3}$.

\begin{align*} \frac{10A\!+\!3B\!+\!12C}{25}\!=&\frac 35\,\frac{B\!+\!4C}{5}\!+\!\Big(1\!-\!\frac 35\Big)A \!=\!\frac {16}{25}\,\frac{A\!+\!3C}{4}\!+\!\Big(1\!-\!\frac {16}{25}\Big)\frac{2A\!+\!B}{3}\\ \!=&\frac 15\,\frac{3B\!+\!2C}{5}\!+\!\Big(1\!-\!\frac 15\Big)\frac{A\!+\!C}{2},\\ \frac{A\!+\!2B\!+\!3C}{6}\!=&\frac 56\,\frac{2B\!+\!3C}{5}\!+\!\Big(1\!-\!\frac 56\Big)A \!=\!\frac 23\,\frac{A\!+\!3C}{4}\!+\!\Big(1\!-\!\frac 23\Big)B\\ \!=&\frac C2\!+\!\Big(1\!-\!\frac 12\Big)\frac{A\!+\!2B}{3},\\ \frac{4A\!+\!2B\!+\!3C}{9}\!=&\frac 59\,\frac{2B\!+\!3C}{5}\!+\!\Big(1\!-\!\frac 59\Big)A \!=\!\frac 23\,\frac{A\!+\!C}{2}\!+\!\Big(1\!-\!\frac 23\Big)\frac{A\!+\!2B}{3}\\ \!=&\frac C3\!+\!\Big(1\!-\!\frac 13\Big)\frac{2A\!+\!B}{3}, \end{align*}

### 附錄 (本文實驗 mathematica 代碼)

Clear["*"];
A = {0, 0}; B={1,0};C1 = {xc, yc}; E1 = {1, -1};
D1 = {0, -1}; F = {-yc, xc}; G = C1 + F;
(*寫出所有點的座標*)
Subsets[{A, B, C1, D1, E1, F, G}, {3}](*每次取三個點的座標*)
Area@Polygon[#] & /@ Subsets[{A, B, C1, D1, E1, F, G}, {3}]
(*測量所取三個點構成的三角形面積*)
Framed /@ GatherBy[%,Last] /. {(k_ -> v_) :> (k -> Style[v, Red])} // Column
(*將面積相等的三角形收集在一起*)


n = 4;
pts = Table[(-1)^((2 i - 3)/n - 1/2), {i, n}];(*生成第一個正n邊形的頂點*)
pt = pts[[3]];
pts2 = pt + (pts - pt) RandomReal[{0.8, 0.82}]
E^(I RandomReal[{120, 123} Pi/180]);
(*生成第二個正n邊形的頂點*)
pair = Cases[GatherBy[Flatten[Table[{pts[[i]], pts[[j]],k},{i,n},{j,i+1,n},
{k, Select[pts2, Abs[# - pt] > 10^-8 &]}], 2],
Round[Abs@Im[Conjugate[#]. RotateLeft[#]], 10.^-8] &], {_, _}];
(*將所有面積相等的三角形收集在一起*)
Graphics[{RegionBoundary /@ Polygon /@ ReIm@{pts, pts2}, {Opacity[0.2],
Flatten@Riffle[{EdgeForm[{#,Thick}],#} &/@{Red,Green},Polygon/@ ReIm@#]}},
BaseStyle -> 14, ImageSize -> 250] & /@ pair //
Partition[#, 2, 2, 1, {}] & // Grid (*繪製圖形, 使之視覺化*)


Clear["*"];
eps = 10^-8.;
sameLine[{{x1_, y1_}, {x2_, y2_}}]
:=Round[#/Total@# &@{y1-y2, x2-x1, x1 y2-x2 y1}, eps];
lineConcurrent[{{{x1_,y1_},{x2_,y2_}},{{x3_,y3_},{x4_, y4_}},
{{x5_, y5_},{x6_, y6_}}}] := Abs[Det[{{y1-y2, x2-x1, x1 y2-x2 y1},
{y3-y4, x4-x3, x3 y4-x4 y3}, {y5-y6, x6-x5, x5 y6-x6 y5}}]] < eps;
(*判斷三條線是否共點*)
{A1, B1, C1} = {RandomReal[{0.3, 1}, 2], {0, 0}, {1, 0}} // N;
{X1, X2} = ({{1, 2}, {2, 1}}/3) . {A1, B1};
{Y1, Y2, Y3} = ({{1, 3}, {2, 2}, {3, 1}}/4) . {C1, A1};
{Z1,Z2,Z3,Z4} = ({{1, 4},{2, 3},{3, 2},{4, 1}}/5) . {B1, C1};
(*生成基本圖形*)
Dimensions[
ans = Select[Select[Subsets[DeleteDuplicatesBy[Subsets[{A1,
B1, C1, X1, X2, Y1, Y2, Y3, Z1, Z2, Z3, Z4}, {2}], sameLine], {3}],
DuplicateFreeQ@*Catenate], lineConcurrent]];
Length /@ (gb =GatherBy[ans, Equal @@
Round[Mod[ArcTan @@@ Subtract @@@ #, Pi], eps] &]);
Graphics[{Line[{A1, B1, C1, A1}], PointSize[0.03],
Point[{A1, B1, C1, X1, X2, Y1, Y2, Y3, Z1, Z2, Z3, Z4}],
{Red, InfiniteLine /@ #,
RegionIntersection[InfiniteLine /@ #[[1 ;; 2]]]}},
PlotRangePadding -> Scaled[.1]] & /@ gb[[1]] //
Partition[#,5,5,1, {}] & // Grid(*遍歷查找三線共點的情況, 作圖輸出*)


Clear["*"];
(*定義三點共線的函數sdgxQ*)
sdgxQ[{P1_, P2_, P3_, P4_, P5_, P6_}] := Module[{ },
sol = {Solve[
Coefficient[t1 P1 + (1 - t1) P2 -  P3 , {A, B, C}] == 0, {t1,
t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }],
Solve[Coefficient[t2 P1 + (1 - t2) P2 -  P4 , {A, B, C}] ==
0, {t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }],
Solve[Coefficient[t3 P1 + (1 - t3) P2 -  P5 , {A, B, C}] ==
0, {t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }],
Solve[Coefficient[t4 P1 + (1 - t4) P2 -  P6, {A, B, C}] ==
0, {t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }],
Solve[Coefficient[t5 P3 + (1 - t5) P4 -  P1 , {A, B, C}] ==
0, {t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }],
Solve[Coefficient[t6 P3 + (1 - t6) P4 -  P2 , {A, B, C}] ==
0, {t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }],
Solve[Coefficient[t7 P3 + (1 - t7) P4 -  P5 , {A, B, C}] ==
0, {t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }],
Solve[Coefficient[t8 P3 + (1 - t8) P4 -  P6 , {A, B, C}] ==
0, {t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }],
Solve[Coefficient[t9 P5 + (1 - t9) P6 -  P1 , {A, B, C}] == 0, {t1,
t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }],
Solve[Coefficient[t10 P5 + (1 - t10) P6 -  P2 , {A, B, C}] ==
0, {t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }],
Solve[Coefficient[t11 P5 + (1 - t11) P6 -  P3 , {A, B, C}] ==
0, {t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }],
Solve[Coefficient[t12 P5 + (1 - t12) P6 -  P4 , {A, B, C}] ==
0, {t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12 }]}// Flatten;
If[sol =!={}, False, True ]]
(*求出三線共點的交點*)
f[{P1_, P2_, P3_, P4_, P5_, P6_}] := Module[{ },
sol = Solve[Coefficient[k1 P1+(1-k1)P2-(k2 P3+(1-k2) P4), {A,B,C}]==0
&& Coefficient[k1 P1+(1-k1) P2-(k3 P5+(1-k3) P6), {A,B,C}]==0 && k1!=0
&& k1!=1 && k2!=0 && k2!=1 && k3!=0 && k3!=1, {k1,k2,k3}] // Factor;

If[sol=!={},{k1 P1 + (1 - k1) P2 /. sol[[1]] //
Factor, HoldForm[k1 P1 +(1-k1)P2==k2 P3+(1-k2)P4
==k3 P5+(1-k3)P6] /. sol[[1]]}, Nothing]]
pailie6[{P1_,P2_,P3_,P4_,P5_,P6_}] := Module[{ },{{P6, P1, P5, P2, P4, P3},
{P6, P1, P5, P3, P4, P2},{P6, P1, P5, P4, P3, P2},{P6, P2, P5, P1, P4, P3},
{P6, P2, P5, P3, P4,P1},{P6, P2, P5, P4, P3, P1},{P6, P3, P5, P1, P4, P2},
{P6, P3,P5, P2, P4, P1},{P6, P3, P5, P4, P2, P1},{P6, P4, P5, P1, P3, P2},
{P6, P4, P5, P2, P3, P1},{P6, P4, P5, P3, P2, P1},{P6, P5,P4, P1, P3, P2},
{P6, P5, P4, P2, P3, P1},{P6, P5, P4, P3, P2,P1}}]
(*pailie6是對六點進行排列。*)
V5 = {A, B, (A + 2 B)/3, (2 A + B)/3, (4 B + C)/5, (2 B + 3 C)/5,
(3B+2C)/5,(B+4 C)/5,(4B+C)/5,(A+3C)/4, (3A+C)/4, (A+C)/2,C} // Union;
SS1 =  Flatten[pailie6 /@ Union@Subsets[V5, {6}], 1]  ;
SS5 = Select[SS1, sdgxQ ];
f /@ SS5 //. {{A, _} -> 0, {B, _} -> 0, {C, _} -> 0}
`