使用dplyr计算95% CI的长度

xkrw2x1b  于 2022-12-20  发布在  其他
关注(0)|答案(6)|浏览(383)

上一次我问如何计算一个变量(procras)的平均分,这个变量已经被多个受访者重复测量,所以我的(简化的)长格式数据集看起来像下面这样(这里有两个学生,5个时间点,没有分组变量):

studentID  week   procras
   1        0     1.4
   1        6     1.2
   1        16    1.6
   1        28    NA
   1        40    3.8
   2        0     1.4
   2        6     1.8
   2        16    2.0
   2        28    2.5
   2        40    2.8

使用dplyr,我会得到每个测量场合的平均得分

mean_data <- group_by(DataRlong, week)%>% summarise(procras = mean(procras, na.rm = TRUE))

看起来像这样,例如:

Source: local data frame [5 x 2]
        occ  procras
      (dbl)    (dbl)
    1     0 1.993141
    2     6 2.124020
    3    16 2.251548
    4    28 2.469658
    5    40 2.617903

使用ggplot2,我现在可以绘制平均值随时间的变化,并且通过轻松调整dplyr的group_data(),我还可以获得每个亚组的均值(例如,男性和女性每个事件的平均评分)。现在我想在mean_data表中添加一列,其中包括每个事件平均评分周围的95% CI的长度。
http://www.cookbook-r.com/Graphs/Plotting_means_and_error_bars_(ggplot2)/解释了如何获取和绘制CI,但是当我想对任何子组进行此操作时,这种方法似乎就出现了问题,对吗?那么,是否有一种方法可以让dplyr也将CI(基于组大小等)自动包含在mean_data中?之后,将新值作为CI绘制到图表中应该相当容易,我希望如此。谢谢。

yvfmudvl

yvfmudvl1#

您可以使用mutate手动执行此操作,summarise中有一些额外的函数

library(dplyr)
mtcars %>%
  group_by(vs) %>%
  summarise(mean.mpg = mean(mpg, na.rm = TRUE),
            sd.mpg = sd(mpg, na.rm = TRUE),
            n.mpg = n()) %>%
  mutate(se.mpg = sd.mpg / sqrt(n.mpg),
         lower.ci.mpg = mean.mpg - qt(1 - (0.05 / 2), n.mpg - 1) * se.mpg,
         upper.ci.mpg = mean.mpg + qt(1 - (0.05 / 2), n.mpg - 1) * se.mpg)

#> Source: local data frame [2 x 7]
#> 
#>      vs mean.mpg   sd.mpg n.mpg    se.mpg lower.ci.mpg upper.ci.mpg
#>   (dbl)    (dbl)    (dbl) (int)     (dbl)        (dbl)        (dbl)
#> 1     0 16.61667 3.860699    18 0.9099756     14.69679     18.53655
#> 2     1 24.55714 5.378978    14 1.4375924     21.45141     27.66287
toe95027

toe950272#

我使用 gmodels 包中的 ci 命令:

library(gmodels)
your_db %>% group_by(gouping_variable1, grouping_variable2, ...)
        %>% summarise(mean = ci(variable_of_interest)[1], 
                      lowCI = ci(variable_of_interest)[2],
                      hiCI = ci(variable_of_interest)[3], 
                      sd = ci (variable_of_interest)[4])
ulydmbyx

ulydmbyx3#

如果您想使用boot包的多功能性,我找到了this blog post useful(下面的代码就是从那里得到的灵感)

library(dplyr)
library(tidyr)
library(purrr)
library(boot)

set.seed(321)
mtcars %>%
  group_by(vs) %>%
  nest() %>% 
  mutate(boot_res = map(data,
                        ~ boot(data = .$mpg,
                               statistic = function(x, i) mean(x[i]),
                               R = 1000)),
         boot_res_ci = map(boot_res, boot.ci, type = "perc"),
         mean = map(boot_res_ci, ~ .$t0),
         lower_ci = map(boot_res_ci, ~ .$percent[[4]]),
         upper_ci = map(boot_res_ci, ~ .$percent[[5]]),
         n =  map(data, nrow)) %>% 
  select(-data, -boot_res, -boot_res_ci) %>% 
  unnest(cols = c(n, mean, lower_ci, upper_ci)) %>% 
  ungroup()
#> # A tibble: 2 x 5
#>      vs  mean lower_ci upper_ci     n
#>   <dbl> <dbl>    <dbl>    <dbl> <int>
#> 1     0  16.6     15.0     18.3    18
#> 2     1  24.6     22.1     27.3    14

reprex package(v0.3.0)于2020年1月22日创建
代码的一些解释:
nest()嵌套时,列表列(默认情况下称为data),其包含2个 Dataframe ,是由vs分组的整个mtcars的2个子集(其包含2个唯一值0和1)。然后,使用mutate()map(),我们通过将来自boot包的函数boot()应用于列表列data来创建列表列boot_res。然后通过将boot.ci()函数应用于boot_res列表列来创建boot_res_ci列表列,依此类推。对于select(),我们删除不再需要的列表列。接下来是取消嵌套和取消分组最终结果。
不幸的是,代码不容易导航,但它服务于另一个示例的目的。

使用broom::tidy()

我刚刚意识到broom包实现了一个方法来处理boot()的输出,正如here所指出的那样,这使得代码更简洁,输出更完整,包括偏差和统计数据的标准误差(这里是平均值):

library(dplyr)
library(tidyr)
library(purrr)
library(broom)
library(boot)

set.seed(321)
mtcars %>%
  group_by(vs) %>%
  nest() %>% 
  mutate(boot_res = map(data,
                        ~ boot(data = .$mpg,
                               statistic = function(x, i) mean(x[i]),
                               R = 1000)),
         boot_tidy = map(boot_res, tidy, conf.int = TRUE, conf.method = "perc"),
         n = map(data, nrow)) %>% 
  select(-data, -boot_res) %>% 
  unnest(cols = -vs) %>% 
  ungroup()
#> # A tibble: 2 x 7
#>      vs statistic    bias std.error conf.low conf.high     n
#>   <dbl>     <dbl>   <dbl>     <dbl>    <dbl>     <dbl> <int>
#> 1     0      16.6 -0.0115     0.843     15.0      18.3    18
#> 2     1      24.6 -0.0382     1.36      22.1      27.3    14

reprex package(v0.3.0)于2020年1月22日创建

data.table简明语法

但是,请注意,我使用data.table包而不是dplyr得到了一个更简洁的语法:

library(data.table)
library(magrittr)
library(boot)
library(broom)

mtcars <- mtcars %>% copy %>% setDT

set.seed(321)
mtcars[, c(n = .N,
           boot(data = mpg,
                statistic = function(x, i) mean(x[i]),
                R = 1000) %>% 
             tidy(conf.int = TRUE, conf.method = "perc")),
       by = vs]
#>    vs  n statistic        bias std.error conf.low conf.high
#> 1:  0 18  16.61667 -0.01149444 0.8425817 15.03917  18.26653
#> 2:  1 14  24.55714 -0.03822857 1.3633112 22.06429  27.32839

reprex package于2020年1月23日创建(版本0.3.0)

一次使用数据表的多个变量

library(data.table)
library(magrittr)
library(boot)
library(broom)

mtcars <- mtcars %>% copy %>% setDT

# Specify here the variables for which you want CIs
variables <- c("mpg", "disp") 

# Function to get the CI stats, will be applied to each column of a subset of
# data (.SD)
get_ci <- function(varb, ...){
  boot(data = varb,
       statistic = function(x, i) mean(x[i]),
       R = 1000) %>% 
    tidy(conf.int = TRUE, ...)
}

set.seed(321)
mtcars[, c(n = .N,
           lapply(.SD, get_ci) %>% 
             rbindlist(idcol = "varb")),
       by = vs, .SDcols = variables]
#>    vs  n varb statistic        bias  std.error  conf.low conf.high
#> 1:  0 18  mpg  16.61667 -0.01149444  0.8425817  15.03917  18.26653
#> 2:  0 18 disp 307.15000 -1.49692222 23.1501247 261.18766 353.04416
#> 3:  1 14  mpg  24.55714 -0.03215714  1.3800432  21.86628  27.50551
#> 4:  1 14 disp 132.45714  0.32994286 14.9070552 104.45798 163.57344

reprex package(v0.3.0)于2020年1月23日创建

carvr3hs

carvr3hs4#

更新tidyr 1.0.0

@Valentin给出的所有解决方案都是可行的,但我想提示一个新的替代方案,它对你们中的一些人来说更容易阅读。它用一个相对较新的[tidyr 1.0.0][1]函数unnest_wider替换了所有summarise解决方案。

mtcars %>% 
  nest(data = -"vs") %>%
  mutate(ci = map(data, ~ MeanCI(.x$mpg, method = "boot", R = 1000))) %>% 
  unnest_wider(ci)

其给出:

# A tibble: 2 x 5
     vs data                mean lwr.ci upr.ci
  <dbl> <list>             <dbl>  <dbl>  <dbl>
1     0 <tibble [18 × 10]>  16.6   14.7   18.5
2     1 <tibble [14 × 10]>  24.6   22.0   27.1

不使用 Bootstrap 法计算置信区间甚至更简单:

mtcars %>% 
  nest(data = -"vs") %>%
  mutate(ci = map(data, ~ MeanCI(.x$mpg))) %>% 
  unnest_wider(ci)
2hh7jdfx

2hh7jdfx5#

对于正态分布:

library(dplyr)
mtcars %>%
  group_by(vs) %>%
  summarise(mean.mpg = mean(mpg, na.rm = TRUE),
            sd.mpg = sd(mpg, na.rm = TRUE),
            n.mpg = n()) %>%
  mutate(se.mpg = sd.mpg / sqrt(n.mpg),
         lower.ci.mpg = mean.mpg - qnorm(0.975) * se.mpg,
         upper.ci.mpg = mean.mpg + qnorm(0.975) * se.mpg)
ki0zmccv

ki0zmccv6#

添加一个答案,以防其他人,像我一样,发现这篇文章有用,但仍在寻找调整。
下面是一个基于@sboysel的响应并使用他的“nobs”函数的替代手动解决方案。如果你想对数据中的多个组和多个变量进行汇总,这个解决方案很有用(改变across()以适应你的数据--这里,它是为以特定字符串开头的变量编写的):

output1 <- your_data_frame %>% 
  dplyr::group_by(your_grouping_variable) %>% 
  dplyr::summarise(across(starts_with("your_string"),
                          .fns = list(
                            mean = ~mean(.x, na.rm = TRUE), 
                            sd = ~sd(.x, na.rm = TRUE), 
                            se = ~sd(.x, na.rm = TRUE)/sqrt(length(.x)),
                            n = ~nobs(.x),
                            ci_l = ~mean(.x, na.rm = TRUE) - (1.96 * sd(.x, na.rm = TRUE)/sqrt(nobs(.x))),
                            ci_u = ~mean(.x, na.rm = TRUE) + (1.96 * sd(.x, na.rm = TRUE)/sqrt(nobs(.x))))))

或者,使用gmodels包中的ci(如@carfisma所说)来获得更简洁的代码:

output2 <- your_data_frame%>% 
  dplyr::group_by(your_grouping_variable) %>% 
  dplyr::summarise(across(starts_with("your_string"),
                          .fns = list(
                            mean = ~ci(.x, na.rm=TRUE)[1],
                            se = ~ci(.x, na.rm=TRUE)[4],
                            n = ~nobs(.x),
                            ci_l = ~ci(.x, na.rm=TRUE)[2], # confidence level default is 0.95
                            ci_u = ~ci(.x, na.rm=TRUE)[3])))

注意,ci()输出的第4个元素是std err,而不是carfisma解决方案中可能建议的sd。
使用dplyr版本1.0.10和gmodels 2.18.1.1

相关问题