web-dev-qa-db-ja.com

dplyrを使用して95%-CIの長さを計算する

前回、複数の回答者に対して繰り返し測定された変数(procras)の測定機会(週)あたりの平均スコアを計算する方法を尋ねました。したがって、長い形式の私の(簡略化された)データセットは、たとえば次のようになります(ここでは、2人の学生、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テーブルに列を追加します。この列には、1回あたりの平均スコアの周りの95%-CIの長さが含まれています。

http://www.cookbook-r.com/Graphs/Plating_means_and_error_bars_(ggplot2)/ CIを取得してプロットする方法を説明していますが、このアプローチは、私がこれをやりたいと思ったらすぐに問題になるようです。サブグループはありますか?では、dplyrがCI(グループサイズなどに基づく)をmean_dataに自動的に含めるようにする方法はありますか?その後、新しい値をCIとしてグラフにプロットするのはかなり簡単なはずです。ありがとうございました。

11
Rasul89

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
21
sboysel

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])
7
carfisma

bootパッケージの多様性を使用したい場合は、 このブログ投稿は役に立ちます (以下のコードはそこから着想を得ています)

_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パッケージ (v0.3.0)によって2020-01-22に作成されました

コードの説明:

nest()でネストすると、リスト列(デフォルトではdataと呼ばれます)が作成されます。この列には2つのデータフレームが含まれ、mtcars(0と1の2つの一意の値を含む)でグループ化されたvs全体の2つのサブセットです。 )。次に、mutate()map()を使用して、bootパッケージの関数boot()をリスト列dataに適用することにより、リスト列_boot_res_を作成します。次に、boot.ci()関数を_boot_res_ci_リスト列などに適用して_boot_res_リスト列を作成します。 select()を使用して、不要になったリスト列を削除し、最終結果のネストを解除してグループ化を解除します。

残念ながら、コードはナビゲートするのが簡単ではありませんが、別の例の目的を果たします。

broom::tidy()の使用

パッケージbroomには、指摘されているようにboot()出力を処理するメソッドの実装があることに気づきました ここ 。これにより、コードの冗長性が少し減り、統計のバイアスや標準誤差(ここでの平均)など、出力がさらに完全になります。

_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パッケージ (v0.3.0)によって2020-01-22に作成されました

_data.table_簡潔な構文

ただし、dplyrの代わりに_data.table_パッケージを使用することで、より簡潔な構文になったことに注意してください。

_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パッケージ (v0.3.0)によって2020-01-23に作成されました

Data.tableで一度に複数の変数

_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パッケージ (v0.3.0)によって2020-01-23に作成されました

1
Valentin