Question

有4个方程式和4个未知数；我在寻找根源。但是我相信使用多根函数时可能会遗漏某些地方。这是主要问题。我有400个方程式可以用这种格式求解。我不仅需要这个特定的方程式，还需要所有这些。

该函数的结果是：

expA : 0.23
expB : 0.23
expC : 0.48
expD : 0

a : 0.02
b : 0.02
c : 0.02
d : 0

但是，当我手头计算时，我会发现

a=b=0.125 c=d=0

expA=0.125
expB=0.125
expC=0.500
expD=0

我尝试了不同的起始值，但是都没有改变解决方案。

library(rootSolve)
V=1
a1=V/2
a2=V
a3=0
a4=0
b1=0
b2=0
b3=V/2
b4=V
c1=V/2
c2=0
c3=V/2
c4=0
d1=0
d2=0
d3=0
d4=0

在这里定义方程式：

expA<-expression(a/(a+b)*(c/(c+d)*a1+d/(c+d)*a2)+b/(a+b)*(c/(c+d)*a3+d/(c+d)*a4)-a)

expB<-expression(a/(a+b)*(c/(c+d)*b1+d/(c+d)*b2)+b/(a+b)*(c/(c+d)*b3+d/(c+d)*b4)-b)

expC<-expression(a/(a+b)*(c/(c+d)*c1+d/(c+d)*c2)+b/(a+b)*(c/(c+d)*c3+d/(c+d)*c4)-c)

expD<-expression(a/(a+b)*(c/(c+d)*d1+d/(c+d)*d2)+b/(a+b)*(c/(c+d)*d3+d/(c+d)*d4)-d)

derA<-D(expA, "a")

derB<-D(expB, "b")

derC<-D(expC, "c")

derD<-D(expD, "d")

replacement<-function(derA)
{
  derA<-do.call('substitute', list(derA, list(a=quote(x[1]))))
  derA<-do.call('substitute', list(derA, list(b=quote(x[2]))))
  derA<-do.call('substitute', list(derA, list(c=quote(x[3]))))
  derA<-do.call('substitute', list(derA, list(d=quote(x[4]))))

  return(derA)
}

derA<-replacement(derA)
derB<-replacement(derB)
derC<-replacement(derC)
derD<-replacement(derD)


model<-function(x){

  f1<-eval(derA)

  f2<-eval(derB)

  f3<-eval(derC)

  f4<-eval(derD)

  c(f1 = f1, f2 = f2,f3=f3,f4=f4)
}

ss <- multiroot(f = model, start = c(0.02, 0.02, 0.02, 0.02), useFortran = TRUE)

a<-ss$root[1]
b<-ss$root[2]
c<-ss$root[3]
d<-ss$root[4]
eval(expA)
eval(expB)
eval(expC)
eval(expD)

if (eval(expA)<0) {a=0}
if (eval(expB)<0) {b=0}
if (eval(expC)<0) {c=0}
if (eval(expD)<0) {d=0}

print(eval(expA))
print(eval(expB))
print(eval(expC))
print(eval(expD))

print(a)
print(b)
print(c)
print(d)

只有警告消息：“对角元素为零”，并且迭代次数为1。

rootsolve :: multiroot函数对角元素为零的问题

0 个答案: