在Mathematica中求解一个四方程(log)的方程组。

I am trying to solve a system of four equations in four variables. I have read a number of threads on similar issues and tried to follow the suggestions. But I think it is a bit messy because of the logs and cross products here. This is the exact system:

我试着用四个变量来解一个四方程的方程组。我已经在类似的问题上阅读了一些帖子，并试图遵循这些建议。但我觉得这有点乱，因为这里有圆木和叉乘。这就是精确的系统:

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])

7 * w =(7 * w + 5 * x + 2 * y + z)*(0.76 + 0.12 *日志日志[x][w]-0.08 * -0.03 * -0.07日志[y]*日志(7 * w + 5 * x + 2 * y + z)),5 * x =(7 * w + 5 * x + 2 * y + z)*(0.84 - 0.08 *日志日志[x][w]+ 0.11 * -0.02 * -0.08日志[y]*日志(7 * w + 5 * x + 2 * y + z)),2 * y =(7 * w + 5 * x + 2 * y + z)*(-0.45 - 0.03 *日志日志[x]+[w]-0.02 * 0.05 *日志[y]+ 0.12 *日志(7 * w + 5 * x + 2 * y + z)),1 * z =(7 * w + 5 * x + 2 * y + z)*(-0.16 + 0 *日志[w]日志[x]- 0 - 0 * *日志[y]+ 0.03 *日志(7 * w + 5 * x + 2 * y + z))

(FYI-I am a young economist, and this is an extension of a consumer demand system.) Theoretically, we know that there exists a unique solution to this system that is positive.

(我是一名年轻的经济学家，这是消费需求系统的延伸。)从理论上讲，我们知道这个系统有一个唯一的正解。

Trys

与追求

Solve & NSolve : As there should be a solution I tried these but neither works. I guess that the system has too many logs to handle.

解决和解决:因为应该有一个解决方案，我尝试了这些，但都不起作用。我想系统有太多日志要处理。
FindRoot : I started with an initial value of (14,15,10,100) which I get from my data. FindRoot returns the last value (which does not satisfy my system) and the following message.

FindRoot:我从数据中得到的初始值(14,15,10100)开始。FindRoot返回最后一个值(它不满足我的系统)和以下消息。

FindRoot::lstol: The line search decreased the step size to within tolerance specified by AccuracyGoal and PrecisionGoal but was unable.....

:直线搜索通过精确目标和精确目标，将步长降低到允许的范围内，但无法实现。

I tried different initial values, including the value returned by FindRoot. I tried to analyze the pattern of the solution value at each step. I didn’t see any pattern but noticed that the z values become negative early in the process. So I put bounds on the values. This just stops the code at the minimum value of 0.1. I also tried an exponential system instead of log, same issues.

我尝试了不同的初始值，包括FindRoot返回的值。我尝试分析每个步骤中解决方案值的模式。我没有看到任何模式，但是注意到z值在这个过程的早期就变成了负值。所以我对这些值做了积分。这只是将代码的最小值设置为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 : As we can write this problem as a minimization problem, I tried this (following the suggestion here). The value returned did not converge the system or equations to zero. I tried with only the first two equations, and that sort of converged to zero.
FindMinimum:我们可以把这个问题作为一个最小化的问题来写，我尝试了这个(根据这里的建议)。返回的值没有将系统或方程收敛到零。我只尝试了前两个方程，然后收敛到0。

Hope this is engaging enough for the experts here! Any ideas how I should find the solution or why can’t I? It’s the first time I am using Mathematica, and unfortunately the first time I am empirically solving a system/optimizing! Thanks a lot.

希望这对这里的专家有足够的吸引力!你知道我应该怎么找到解决办法吗?这是我第一次使用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 个解决方案

#1

I don't have access to Mathematica, I put your equations into AMPL which is free for students. Here is what I did:

我无法访问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;
    }
}

If I only require that the variables are nonnegative, I get rubbish, for example

如果我只要求变量是非负的，我就会得到垃圾。

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, they satisfy the equations to a fairly high precision, although I am pretty sure it's not what you are looking for. This indicates issues with your model.

从数值上讲，它们确实是解，它们满足方程的精度相当高，尽管我很确定这不是你想要的。这表明您的模型存在问题。

If I increase the lower bounds of the variables a bit:

如果我把变量的下界增加一点:

var w := 14 >= 0.1;
var x := 15 >= 0.1;
var y := 10 >= 0.1;
var z := 100 >= 0.01;

I get, even with multistart, Ipopt 3.11.6: Converged to a locally infeasible point. Problem may be infeasible. This again indicates issues with your model equations.

我得到，即使是多起点，Ipopt 3.11.6:收敛到一个局部不可行点。问题可能是不可行的。这再次表明您的模型方程存在问题。

I am afraid you will have to revise your model.

恐怕你得修改你的模型了。

This won't fix the issues with your model equations but I would introduce new variables: a=log(w), b=log(x), c=log(y), d=log(z). Then w=exp(a) and so on. It has the advantage that the function evaluations won't fail due to negative arguments for the logarithm function.

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

I would probably also introduce a new variable for (7*w+5*x+2*y+z) just to make the equations more compact.

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

Neither of these new variables will solve the above issues with your model equations.

这些新变量都不能用你的模型方程来解决上述问题。

If it is really your first time using Mathematica, you might be better off with AMPL and IPOPT; these tools are custom-tailored for solving equations and optimization problems. I suggest you use the AMPL mailing list if you have question and not *; you will get better answers on the mailing list.

如果这真的是你第一次使用Mathematica，你最好使用AMPL和IPOPT;这些工具是为解决方程和优化问题定制的。我建议您使用AMPL邮件列表，如果您有问题，而不是*;你会在邮件列表上得到更好的答案。

#2

This method will often rapidly find approximate solutions, NMinimize the sum of squares with constraints.

该方法通常能快速找到近似解，并将约束条件的平方和最小化。

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}}

#1