在Mathematica中求解四个方程组（带有对数）-Java 学习之路

我试图在四个变量中解决四个方程的系统 . 我已经阅读了类似问题的一些主题，并尝试遵循这些建议 . 但是我觉得这里的日志和交叉产品有点乱 . 这是确切的系统：

7 * w =（7 * w 5 * x 2 * yz）（0.76 0.12 * Log [w] -0.08 * Log [x] -0.03 * Log [y] -0.07 * Log [7 * w 5 * x 2 * YZ]），
5 * x =（7 * w 5 * x 2 * yz）（0.84 - 0.08 * Log [w] 0.11 * Log [x] -0.02 * Log [y] -0.08 * Log [7 * w 5 * x 2 * YZ]），
2 * y =（7 * w 5 * x 2 * yz）（-0.45 - 0.03 * Log [w] -0.02 * Log [x] 0.05 * Log [y] 0.12 * Log [7 * w 5 * x 2 * YZ]），
1 * z =（7 * w 5 * x 2 * yz）（ - 0.16 0 * Log [w] - 0 * Log [x] - 0 * Log [y] 0.03 * Log [7 * w 5 * x 2 * YZ]）

（仅供参考 - 我是一名年轻的经济学家，这是消费者需求系统的延伸 . ）从理论上讲，我们知道这个系统存在一个独特的解决方案，即积极的 .

Trys

Solve＆NSolve：因为应该有一个解决方案，我试过这些，但都不起作用 . 我猜这个系统有太多的日志需要处理 .
FindRoot：我从初始值（14,15,10,100）开始，从数据中得到 . FindRoot返回最后一个值（不满足我的系统）和以下消息 .

FindRoot :: lstol：行搜索将步长减小到AccuracyGoal和PrecisionGoal指定的容差范围内，但无法.....

我尝试了不同的初始值，包括FindRoot返回的值 . 我试图分析每一步的解决方案 Value 模式 . 我没有看到任何模式，但注意到z值在此过程的早期变为负值 . 所以我对 Value 观进行了限制 . 这只是将代码停在最小值0.1 . 我也试过一个指数系统而不是log，同样的问题 .

Reap[FindRoot[{
 7*w==(7*w+5*x + 2*y + z)*(0.76 + 0.12*Log[w] -0.08*Log[x] -0.03*Log[y] -0.07*Log[7*w+5*x + 2*y + z]),
 5*x==(7*w+5*x + 2*y + z)*(0.84  -0.08*Log[w] +0.11*Log[x] -0.02*Log[y] -0.08*Log[7*w+5*x + 2*y + z]),
 2*y==(7*w+5*x + 2*y + z)*(-0.45 - 0.03*Log[w] -0.02*Log[x] +0.05*Log[y] +0.12*Log[7*w+5*x + 2*y + z]),
 z==(7*w+5*x + 2*y + z)*(-0.16 + 0*Log[w] -0*Log[x] -0*Log[y] +0.03*Log[7*w+5*x + 2*y + z])},
      {{w,14,0.1,500},{x,15,0.1,500},{y,10,0.1,500},        
       {z,100,0.1,500}},EvaluationMonitor:>Sow[{w,x,y,z}] ]]

FindMinimum：我们可以将此问题写成最小化问题，我尝试了这个（遵循此处的建议） . 返回的值不会使系统或方程收敛为零 . 我只尝试了前两个方程，那种方法收敛到零 .

希望这对于这里的专家来说足够吸引人！任何想法我应该如何找到解决方案或为什么我不能？这是我第一次使用Mathematica，不幸的是我第一次凭经验解决系统/优化问题！非常感谢 .

{g1,g2,g3, g4}={7*w - (7*w+5*x+2*y+z)* (0.76+0.12*Log[w]-0.08*Log[x]-0.03*Log[y] -0.07*Log[7*w+5*x+2*y+z]),5*x - (7*w+5*x+2*y+z)*(0.84-0.08*Log[w]+0.11*Log[x]-0.02*Log[y] -0.08*Log[7*w+5*x+2*y+z]),2*y - (7*w+5*x+2*y+z)*(-0.45-0.03*Log[w]-0.02*Log[x]+0.05*Log[y]+0.12*Log[7*w+5*x+2*y+z]), 1*z - (7*w+5*x+2*y+z)*(-0.16+0*Log[w]-0*Log[x]-0*Log[y]+0.03*Log[7*w+5*x+2*y+z])};subdomain=0<w<100 &&0<x<100 && 0<y<100 && 0<z<100;res=FindMinimum[{Total[{g1,g2,g3, g4}^2],subdomain},{w,x,y,z},AccuracyGoal->5]{g1,g2,g3,g4}/.res[[2]]

2 回答

0
我没有访问Mathematica，我将你的方程式放入AMPL，这对学生是免费的 . 这是我做的：
```
var w := 14 >= 0;
var x := 15 >= 0;
var y := 10 >= 0;
var z := 100 >= 0;

eq1: 7*w = (7*w+5*x+2*y+z) * ( 0.76 + 0.12*log(w) -0.08*log(x) -0.03*log(y) -0.07*log(7*w+5*x + 2*y + z));
eq2: 5*x = (7*w+5*x+2*y+z) * ( 0.84 - 0.08*log(w) +0.11*log(x) -0.02*log(y) -0.08*log(7*w+5*x + 2*y + z));
eq3: 2*y = (7*w+5*x+2*y+z) * (-0.45 - 0.03*log(w) -0.02*log(x) +0.05*log(y) +0.12*log(7*w+5*x + 2*y + z));
eq4: 1*z = (7*w+5*x+2*y+z) * (-0.16 +    0*log(w) -   0*log(x) -   0*log(y) +0.03*log(7*w+5*x + 2*y + z));

option show_stats 1;
option presolve 10;
option solver "/home/ali/ampl/ipopt"; # put your path here

option seed 1731;

# Initial solve
solve;
display w, x, y, z;

# Multistart
for {1..10} {
    for {j in 1.._snvars}
        let _svar[j] := Uniform(1, 50);
    solve;
    if (solve_result_num < 200) then {
      display w, x, y, z;
    }
}
```
例如，如果我只要求变量是非负的，我会得到垃圾
```
w = 2.39266e-11
x = 6.62678e-11
y = 1.57043e-24
z = 7.0842e-10
```
要么
```
w = 1.09972e-12
x = 9.77807e-11
y = 3.36229e-21
z = 1.85441e-09
```
Numerically, these are indeed solutions ，他们满足相当高精度的方程，虽然我很确定它不是你想要的 . 这表明您的模型存在问题 .

如果我稍微增加变量的下限：
```
var w := 14 >= 0.1;
var x := 15 >= 0.1;
var y := 10 >= 0.1;
var z := 100 >= 0.01;
```
我得到了，即使是多头， Ipopt 3.11.6: Converged to a locally infeasible point. Problem may be infeasible. 这再次表明你的模型方程存在问题 .

恐怕你必须修改你的模型 .

这不会解决你的模型方程的问题，但我会引入新的变量： a=log(w), b=log(x), c=log(y), d=log(z) . 然后是 w=exp(a) 等等 . 它的优点是，由于对数函数的负参数，函数评估不会失败 .

我可能还会为 (7*w+5*x+2*y+z) 引入一个新变量，以使方程更紧凑 .

这些新变量都不能解决模型方程的上述问题 .

如果它真的是你第一次使用Mathematica，你可能会更好地使用AMPL和IPOPT;这些工具是为定制和优化问题而量身定制的 . 如果您有疑问而不是Stackoverflow，我建议您使用AMPL mailing list;你会在邮件列表上得到更好的答案 .
回复于 2024-04-28T07:35:12+08:00

这种方法通常会快速找到近似解，最小化具有约束的平方和 .

In[2]:= NMinimize[{
   (7*w - (7*w + 5*x + 2*y + z)*(0.76 + 0.12*Log[w] - 0.08*Log[x] - 
     0.03*Log[y] - 0.07*Log[7*w + 5*x + 2*y + z]))^2 +
   (5*x - (7*w + 5*x + 2*y + z)*(0.84 - 0.08*Log[w] + 0.11*Log[x] - 
     0.02*Log[y] - 0.08*Log[7*w + 5*x + 2*y + z]))^2 +
   (2*y - (7*w + 5*x + 2*y + z)*(-0.45 - 0.03*Log[w] - 0.02*Log[x] + 
     0.05*Log[y] + 0.12*Log[7*w + 5*x + 2*y + z]))^2 +
   (1*z - (7*w + 5*x + 2*y + z)*(-0.16 + 0*Log[w] + 
     0.03*Log[7*w + 5*x + 2*y + z]))^2, 
   w > 0 && x > 0 && y > 0 && z > 0}, {w, x, y, z}, 
   Method -> "RandomSearch"]

Out[2]= {9.34024*10^-12, {w->1.86998*10^-8, x->3.83383*10^-8, y->4.59973*10^-8, z->5.29581*10^-7}}

回复于 2024-04-28T07:35:12+08:00

在Mathematica中求解四个方程组（带有对数）

2 回答

相关问题