Question

我是一名游戏理论家，试图使用R中的嵌套循环来模拟军备竞赛模型的解决方案。具体来说，我正在尝试使用uni.root函数找到（1-delta）*（0.1+（1.1-0.1） x）/（1-delta x）-x = 0的根在rootSolve包中。 uni.root识别等式的所有根。在这种情况下，有0,1或2根。

for(mu in seq(0,1,0.2)){
for(delta in seq(0,1,0.2)){
G <- function (x) (1-delta)*(mu+(1.1-mu)*x)/(1-delta*x)-x 
roots <- uniroot.all(G, c(0, 1))
parameter <- c(mu,delta)
print(parameter)
print(roots)}}

我想检索输出矩阵或数据框，列出行中的参数值（mu和delta）和解决方案（如果有）。如下所示：

m1<-expand.grid(seq(0,1,0.2),seq(0,1,0.2))
m<-cbind(m1,c(NA,NA,runif(34)),c(NA,runif(35)))
dimnames(m) = list(1:36,c("mu","delta","root1","root2"))

只要缺少解决方案，NA就会出现。

使用apply函数失败，因为我收到的结果是在列表中。

请帮忙。你的答案可以帮助世界变得更美好。

Answer 1

假设你采用这个程序：

 roots <- matrix(list(),6,6);  
for(mu in seq(0,1,0.2)){

   for(delta in seq(0,1,0.2)){
      G <- function (x) (1-delta)*(mu+(1.1-mu)*x)/(1-delta*x)-x 
      roots[1+mu*5, 1+delta*5] <- 
        if( inherits( rt<- try(uniroot(G, c(0, 1))), "try-error")){NA 
                                                                  }else{ list(rt) }
      parameter <- c(mu,delta)
      print(parameter)
}}

你从uniroot获得了大部分错误，但有5次成功运行：

> roots
     [,1]   [,2]   [,3]   [,4]   [,5]   [,6]
[1,] List,5 List,5 List,5 List,5 List,5 NA  
[2,] NA     NA     NA     NA     NA     NA  
[3,] NA     NA     NA     NA     NA     NA  
[4,] NA     NA     NA     NA     NA     NA  
[5,] NA     NA     NA     NA     NA     NA  
[6,] NA     NA     NA     NA     NA     NA

如果你然后使用rootSolve :: uniroot.all，你得到：

roots <- matrix(list(),6,6);  for(mu in seq(0,1,0.2)){
for(delta in seq(0,1,0.2)){
G <- function (x) (1-delta)*(mu+(1.1-mu)*x)/(1-delta*x)-x 
roots[1+mu*5, 1+delta*5] <- if( inherits( rt<- try(uniroot.all(G, c(0, 1))), "try-error")){NA}else{list(rt)}
parameter <- c(mu,delta)
print(parameter)
}}

> roots
     [,1]      [,2]      [,3]      [,4]      [,5]      [,6]
[1,] 0         Numeric,2 Numeric,2 Numeric,2 Numeric,2 0   
[2,] Numeric,0 Numeric,0 Numeric,2 Numeric,2 Numeric,2 0   
[3,] Numeric,0 Numeric,0 Numeric,0 Numeric,2 Numeric,2 0   
[4,] Numeric,0 Numeric,0 Numeric,0 Numeric,2 Numeric,2 0   
[5,] Numeric,0 Numeric,0 Numeric,0 Numeric,2 Numeric,2 0   
[6,] Numeric,0 Numeric,0 Numeric,0 Numeric,0 Numeric,2 0

这有些不同，因为uniroot.all在输入错误时返回零长度结果。

> roots[5,5]
[[1]]
[1] 0.2065142 0.9684933

> roots[6,1]
[[1]]
numeric(0)

Answer 2

这是我找到的解决方案

p=5 #refinement of interval partition for delta
q=5 #refinement of interval partition for mu
fix <- matrix(list(),(p+1)*(q+1),4)
P <- function(x) {if(length(x)==0) c(NA,NA) 
        else if(length(x)==1) c(0,0) 
        else x} # P converts 'no root result' (numeric(0)) into a vector c(NA,NA)
for(mu in seq(0,1,1/q)){
for(delta in seq(0,1,1/p)){
G <- function (x) (1-delta)*(mu+(1.1-mu)*x)/(1-delta*x)-x 
r <- uniroot.all(G, c(0, 1))
fix[p*delta+(p+1)*q*mu+1,] <- c(mu,delta,P(r))
print(c(mu,delta))
print(r)
}}

dimnames(fix) = list(1:((p+1)*(q+1)),c("mu","delta","root1","root2"))
fix

使用rootSolve包在R中保存循环输出

2 个答案: