在循环/复制时,如何绕开奇异矩阵错误以继续重采样?

时间:2019-05-29 18:25:22

标签: r simulation statistics-bootstrap

我正在基于障碍模型进行两部分的模拟。但是,在引导和重新采样时,我遇到了错误

Error in solve.default(as.matrix(fit_zero$hessian)) : Lapack routine dgesv: system is exactly singular: U[1,1] = 0

运行traceback()之后,我对此感到满意:

19: solve(as.matrix(fit_zero$hessian))
18: hurdle(formula = y ~ m + x, data = boot.data0, dist = "poisson", 
        zero.dist = "binomial") at #21
17: bootstrap(v)
16: FUN(X[[i]], ...)
15: lapply(X = X, FUN = FUN, ...)
14: sapply(integer(n), eval.parent(substitute(function(...) expr)), 
        simplify = simplify)
13: replicate(r, bootstrap(v), simplify = FALSE) at #32
12: unlist(replicate(r, bootstrap(v), simplify = FALSE)) at #32
11: matrix(unlist(replicate(r, bootstrap(v), simplify = FALSE)), 
        ncol = 8, byrow = TRUE) at #32
10: qnorm((sum(boot[, 3] > boot[, 1]) + sum(boot[, 3] == boot[, 1])/2)/r) at #3
9: bias.correct(matrix(unlist(replicate(r, bootstrap(v), simplify = FALSE)), 
       ncol = 8, byrow = TRUE), r) at #32
8: FUN(X[[i]], ...)
7: lapply(X = X, FUN = FUN, ...)
6: sapply(model_values, bootstrapper) at #35
5: FUN(newX[, i], ...)
4: apply(getParameters()[, 2:7], 1, function(parameters) {
       print(parameters)
       PROGRESS <- 0
       seed <- parameters["seed"]
       n <- parameters["n"]
       a <- parameters["a"]
       b <- parameters["b"]
       c <- parameters["c"]
       i <- parameters["i"]
       set.seed(seed)
       model_values <- replicate(iterations, model(n, a, b, c, i), 
           simplify = FALSE)
       bootstrapper <- function(v) {
           PROGRESS <<- PROGRESS + 1
           print(PROGRESS)
           bias.correct(matrix(unlist(replicate(r, bootstrap(v), 
               simplify = FALSE)), ncol = 8, byrow = TRUE), r)
       }
       boot.fit <- sapply(model_values, bootstrapper)
       boot.fit.matrix <- matrix(unlist(boot.fit), ncol = 4, byrow = TRUE)
       averaged <- apply(boot.fit.matrix, 2, mean)
       return(averaged)
   }) at #9
3: main()
2: as_mapper(.f)
1: possibly(main(), otherwise = "error") 

经过先前模糊的堆栈溢出问题和大量研究之后,我意识到在特定样本中,分布完全可能为全0或全1。虽然我无法使用该示例,但我不希望循环(在这种情况下为复制)停止。

我想知道的是,是否存在一种创建条件的方法,例如“如果矩阵是奇异的,请采样下一个迭代”。

我随机生成的数据来自这段代码:


gen.hurdle = function(n, a, b1, b2, c1, c2, i0, i1, i2){

  x = round(rnorm(n),3)
  e = rnorm(n)
  m = round(i0 + a*x + e, 3)

  lambda = exp(i1 + b1*m + c1*x)                       # PUT REGRESSION TERMS FOR THE CONTINUUM PART HERE; KEEP exp()
  ystar = qpois(runif(n, dpois(0, lambda), 1), lambda) # Zero-TRUNCATED POISSON DIST.; THE CONTINUUM PART

  z = i2 + b2*m  + c2*x                                # PUT REGRESSION TERMS FOR THE BINARY    PART HERE
  z_p = exp(z) / (1+exp(z))                            # p(1) = 1-p(0)
  tstar = rbinom(n, 1, z_p)                            # BINOMIAL DIST.         ; THE BINARY    PART

  y= ystar*tstar                                       # TWO-PART COUNT OUTCOME

  return(cbind(x,m,y,z,z_p,tstar))
}

# Returns the base model's powers, type 1 errors, and data
model <- function(n, a, b, c, i){
  #generate random data
  data  = data.frame(gen.hurdle(n, a, b, b, c, c, i, i, i))
  data0 = data.frame(gen.hurdle(n, a, 0, 0, c, c, i, i, i))

我尝试try()trycatch()无济于事,因为我有很多嵌套函数。但是,我读过类似的SO文章,其中指出:“您可以简单地使用函数tryCatch计算矩阵的行列式,而不是使用det。当且仅当行列式为零时,矩阵才是奇异的。 “

在设置此条件时我需要一些帮助。

0 个答案:

没有答案