从BoomSpikeSlab模型中提取包含概率和正概率

Question

plot模型的默认BoomSpikeSlab函数是每个预测变量的包含概率的条形图，以其为正的概率来着色：

set.seed(0)
simulate.lm.spike <- function(n=100, p=10, ngood=3, niter=1000, sigma=1) {
  x <- cbind(matrix(rnorm(n * (p - 1)), nrow=n))
  beta <- c(rnorm(ngood), rep(0, p - ngood))
  y <- rnorm(n, beta[1] + x %*% beta[-1], sigma)
  draws <- lm.spike(y ~ x, niter=niter)
  return(invisible(draws))
}

model <- simulate.lm.spike(n=1000, p=50, sigma=.3)
plot(model, inclusion.threshold=.01)

如何提取该图后面的数据，即每个预测变量的包含概率和为正概率的数据框？

Answer 1

适应PlotMarginalInclusionProbabilities函数：

GetMarginalInclusionProbabilities = function(
    model,
    burn = 0,
    inclusion.threshold = 0,
    unit.scale = TRUE,
    number.of.variables = NULL) {
  beta <- model$beta
  if (burn > 0) {
    beta <- beta[-(1:burn), , drop = FALSE]
  }
  inclusion.prob <- colMeans(beta != 0)
  index <- order(inclusion.prob)
  beta <- beta[, index, drop = FALSE]
  inclusion.prob <- inclusion.prob[index]

  compute.positive.prob <- function(x) {
    ## Compute the probability that x is positive, given that it is
    ## nonzero.  If all(x == 0) then zero is returned.
    x <- x[x != 0]
    if (length(x) == 0) {
      return(0)
    }
    return(mean(x > 0))
  }
  positive.prob <- apply(beta, 2, compute.positive.prob)

  res <- data.frame(predictor = names(inclusion.prob),
                    inclusion.prob = inclusion.prob,
                    positive.prob = positive.prob)

  return(res[order(-res$inclusion.prob), ])
}

示例：

GetMarginalInclusionProbabilities(model)  
#               predictor inclusion.prob positive.prob
# (Intercept) (Intercept)          1.000             1
# x1                   x1          1.000             0
# x2                   x2          0.999             1
# x15                 x15          0.014             1
# x43                 x43          0.002             1