因果影响包:根据模型估算值计算后尾巴区域的概率

时间:2019-02-12 22:01:32

标签: r bayesian inference significance causality

我目前正在使用CausalImpact软件包进行一些研究,在这种情况下,我需要知道并能够解释如何计算后尾部区域概率以便为验证目的而复制该值。有谁知道,在模型提供的数据和估计序列的基础上,如何重现该值?预先感谢!

1 个答案:

答案 0 :(得分:0)

我从来没有使用过这个库,但是浏览了一下代码,看来他们从后验预测分布中计算了样本的分位数(alpha/21-alpha/2)。

来自the relevant section of code(Apache v2.0许可证)

ComputeCumulativePredictions <- function(y.samples, point.pred, y,
                                         post.period.begin, alpha = 0.05) {
  # Computes summary statistics for the cumulative posterior predictions over
  # the unobserved data points in the post-intervention period.
  #
  # Args:
  #   y.samples:         Matrix of simulated response trajectories, as returned
  #                      by \code{ComputeResponseTrajectories()}.
  #   point.pred:        Data frame of point predictions, as returned by
  #                      \code{ComputePointPredictions()}.
  #   y:                 Actual observed response, from the beginning of the
  #                      pre-period to the end of the observed period.
  #   post.period.begin: Index of the first data point of the post-period.
  #   alpha:             The resulting coverage of the posterior intervals will
  #                      be \code{1 - alpha}.
  #
  # Returns:
  #   data frame with 3 columns:
  #     cum.pred:       posterior predictive expectation
  #     cum.pred.lower: lower limit of a \code{(1 - alpha)*100}% interval
  #     cum.pred.upper: upper limit

  ... # [Computing the cum.pred.mean]

  prob.lower <- alpha / 2      # e.g., 0.025 when alpha = 0.05
  prob.upper <- 1 - alpha / 2  # e.g., 0.975 when alpha = 0.05
  cum.pred.lower.post <- as.numeric(t(apply(y.samples.cum.post, 2, quantile,
                                            prob.lower)))
  cum.pred.upper.post <- as.numeric(t(apply(y.samples.cum.post, 2, quantile,
                                            prob.upper)))
  cum.pred.lower <- c(cum.pred.lower.pre, cum.pred.lower.post)
  cum.pred.upper <- c(cum.pred.upper.pre, cum.pred.upper.post)

  # Put cumulative prediction together
  cum.pred <- data.frame(cum.pred = cum.pred.mean,
                         cum.pred.lower, cum.pred.upper)
  return(cum.pred)
}