你能告诉我如何解四个未知数的四个超越方程吗？

Question

我尝试在 MATLAB 和 Mathematica 中求解 4 个 4 个未知数的方程。 我使用 vpasolve 在 MATLAB 中查找未知数。这是 MATLAB 代码。

Y1 = 0.02;
l1 = 0.0172;
syms Y2 Y3 l2 l3;
lambda = [0.0713  0.0688  0.0665];
b1 = 0.1170;
b3 = 0.1252;
t2_1 = (2*pi/lambda(1))*l2; 
t3_1 = (2*pi/lambda(1))*l3; 
t2_3 = (2*pi/lambda(3))*l2; 
t3_3 = (2*pi/lambda(3))*l3; 
t1_1 = (2*pi/lambda(1))*l1;
t1_3 = (2*pi/lambda(3))*l1;
eq1 = 2*Y1*tan(t1_1)+Y2*tan(t2_1)+Y3*tan(t3_1)==0;
eq2 = 2*Y1*tan(t1_3)+Y2*tan(t2_3)+Y3*tan(t3_3)==0;
eq3 = b1== (t1_1*Y1)+(t2_1*(Y2/2)*((sec(t2_1)^2)/(sec(t1_1)^2)))+(t3_1*(Y3/2)*((sec(t3_1)^2)/(sec(t1_1)^2)));
eq4 = b3== (t1_3*Y1)+(t2_3*(Y2/2)*((sec(t2_3)^2)/(sec(t1_3)^2)))+(t3_3*(Y3/2)*((sec(t3_3)^2)/(sec(t1_3)^2)));
E=[eq1 eq2 eq3 eq4];
S=vpasolve(E,[Y2,Y3,l2,l3]);

对于相同的方程，我在 Mathematica 中编写了以下代码。

eqns = {2*Y1*Tan[t11]+Y2*Tan[t21]+Y3*Tan[t31]==0,
2*Y1*Tan[t13]+Y2*Tan[t23]+Y3*Tan[t33]==0,  
t11*Y1 + t21*(Y2/2)*(Sec[t21]^2/Sec[t11]^2) + t31*(Y3/2)*(Sec[t31]^2/Sec[t11]^2)-b1==0, 
t13*Y1 + t23*(Y2/2)*(Sec[t23]^2/Sec[t13]^2) + t33*(Y3/2)*(Sec[t33]^2/Sec[t13]^2)-b3==0};
NMinimize[Norm[Map[First, eqns]], {Y2,Y3,l2,l3}]

但两者都给了我不同的解决方案，而这些都不是必需的解决方案。我想我应该使用其他函数来求解方程。谁能帮我找出如何解决这些方程？非常感谢您的帮助。谢谢。

编辑

如果我使用下面的代码来查找根，我可以找到解决方案，但我只想要正根。我尝试了您提到的用于获得正根的代码，但它不适用于此，我不知道为什么。你能检查一下吗？

    Y1=0.0125;l1=0.010563;lambda={0.0426,0.0401,0.0403,0.0423,0.0413}; b1 = 0.0804;
b3 = 0.0258;
t2_1 = (2*Pi/lambda[[1]])*l2; 
t3_1 = (2*Pi/lambda[[1]])*l3; 
t2_3 = (2*Pi/lambda[[5]])*l2; 
t3_3 = (2*Pi/lambda[[5]])*l3; 
t1_1 = (2*Pi/lambda[[1]])*l1;
t1_3 = (2*Pi/lambda[[5]])*l1;
eqns = {2*Y1*Tan[t11]+Y2*Tan[t21]+Y3*Tan[t31]==0,
2*Y1*Tan[t13]+Y2*Tan[t23]+Y3*Tan[t33]==0,  
t11*Y1 + t21*(Y2/2)*(Sec[t21]^2/Sec[t11]^2) + t31*(Y3/2)*(Sec[t31]^2/Sec[t11]^2)-b1==0, 
t13*Y1 + t23*(Y2/2)*(Sec[t23]^2/Sec[t13]^2) + t33*(Y3/2)*(Sec[t33]^2/Sec[t13]^2)-b3==0};

Answer 1

试试

Y1=0.02;l1=0.0172;lambda={0.0713,0.0688,0.0665};b1=0.1170;b3=0.1252;
t21=(2*Pi/lambda[[1]])*l2;t31=(2*Pi/lambda[[1]])*l3;t23=(2*Pi/lambda[[3]])*l2;
t33=(2*Pi/lambda[[3]])*l3;t11=(2*Pi/lambda[[1]])*l1;t13=(2*Pi/lambda[[3]])*l1;
eqns={2*Y1*Tan[t11]+Y2*Tan[t21]+Y3*Tan[t31]==0,
  2*Y1*Tan[t13]+Y2*Tan[t23]+Y3*Tan[t33]==0,
  t11*Y1+t21*(Y2/2)*(Sec[t21]^2/Sec[t11]^2)+t31*(Y3/2)*(Sec[t31]^2/Sec[t11]^2)-b1==0,
  t13*Y1+t23*(Y2/2)*(Sec[t23]^2/Sec[t13]^2)+t33*(Y3/2)*(Sec[t33]^2/Sec[t13]^2)-b3==0};
tbl=Table[
  {y2i,y3i,l2i,l3i}=RandomReal[{0,.2},4];
  Quiet[root=Check[FindRoot[eqns,{{Y2,y2i,0,.2},{Y3,y3i,0,.2},{l2,l2i,0,.2},{l3,l3i,0,.2}}],False]];
  If[root===False,Nothing,root]
  ,{256}];
roots=Sort[Map[{Y2,Y3,l2,l3}/.#&,tbl],Norm[#1]<Norm[#2]&]
If[roots=={},"It found no roots in that range using those coefficients",
  Map[First,eqns]/.{Y2->roots[[1,1]],Y3->roots[[1,2]],l2->roots[[1,3]],l3->roots[[1,4]]}]

这将查找从大于但接近 0 的 256 个不同随机位置开始的根。我这次编写 FindRoot 的方式，如果搜索超出范围 0,.2，它将停止如果需要，您可以更改该范围.

接下来，您的函数有许多捕获 FindRoot 的局部最小值。所以它应该丢弃在该范围内找到的所有局部最小值。

而且我已经隐藏了警告信息，这通常不是一个好主意。

然后它将对根进行排序以首先显示最接近 0 的根。

如果您希望它排序以显示最接近某个给定值的结果，那么我可以修改排序以首先显示那些，我只需要知道您希望根最接近的位置。

最后，它将找到的最小根的 Y2,Y3,l2,l3 代入四个方程，以证明结果非常接近零，这是一个实根而不是局部最小值。

在尝试了几次之后，我在 {0.0203704,0.0225972,0.0163842,0.0181147} 找到了一个根，如果我交换 Y2 和 Y3 并交换 l2 和 l3，这看起来非常接近您所需的值。这可能是您正在寻找的根吗？

如果您需要更多，请告诉我具体需要什么。

请仔细检查所有这些，以确保我没有犯错。