我希望得到您关于如何为多个列使用purrr包的输入。具体来说，我想做一些基本操作来为每个变量mass创建置信区间(下限和上限)和birth_year通过skin_color，来自starwars数据库。
到目前为止我所做的是:
- 通过skin_color计算我感兴趣的每一列(mass和birth_year)与NA不同的观测数。
pacman::p_load("tidyr","purrr")
data <- starwars
data_obs <-
data %>%
dplyr::select(mass,birth_year,skin_color) %>%
dplyr::group_by(skin_color)%>%
dplyr::summarise_all(funs(sum(!is.na(.))))%>%
dplyr::ungroup()
- 我创建了一个数据库，通过skin_color来估计每个感兴趣变量的平均值和标准差。
data_stats <-
data %>%
dplyr::select(mass,birth_year,skin_color)%>%
dplyr::group_by(skin_color) %>%
dplyr::summarise_all(., list(mean,sd)
, na.rm=T
)%>%
dplyr::ungroup()
- 我合并了两个数据库，这样我就有了不同于NA的观测值，平均值，和每列的sd。
data_complete <-
dplyr::inner_join(data_obs,data_stats, by="skin_color")
从这里开始，很容易手动估计每个变量的标准误差:
data_complete <-
dplyr::mutate(mass_se = mass_sd/sqrt(mass_n),
mass_ci_upper = mass_mean + qt(1 - (0.05 / 2), mass_n - 1)*mass_se,
mass_ci_lower = mass_mean - qt(1 - (0.05 / 2), mass_n - 1)*mass_se)
然而，由于这是我的真实数据集(超过50个变量)的大量工作，我想使用purrr包。我试过这样做:
list_vectors <- list(data$mass,data$birth_year)
list_ready <- map(list_vectors,
~ data %>%
group_by(skin_color)%>%
dplyr::summarise_all(funs(sum(!is.na(.))))%>%
dplyr::summarise_all(., list(mean,sd), na.rm=T) %>%
dplyr::ungroup()%>%
dplyr::mutate(var_se=var_sd/sqrt(var_n)))
vector_1 <- list_ready[[1]]
但这不起作用。任何帮助是真的非常感谢!(我真的很想使用purrr包)。
最简单的方法可能是a)将计算步骤放入处理向量的函数中，并返回具有所需值的tibble列表，b)将其传递给across(使用iris作为示例):
library(tidyverse)
mean_ci <- function(vars) {
vars <- vars[!is.na(vars)]
mn <- mean(vars)
se <- sd(vars) / sqrt(length(vars))
tibble(
mean = mn,
lower = mn - qt(1 - (0.05 / 2), length(vars) - 1) * se,
upper = mn + qt(1 - (0.05 / 2), length(vars) - 1) * se
)
}
iris |>
group_by(Species) |>
summarise(across(where(is.numeric), mean_ci)) |>
unnest(where(is_tibble), names_sep = "_")
#> # A tibble: 3 × 13
#> Species Sepal.Len…¹ Sepal…² Sepal…³ Sepal…⁴ Sepal…⁵ Sepal…⁶ Petal…⁷ Petal…⁸
#> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 setosa 5.01 4.91 5.11 3.43 3.32 3.54 1.46 1.41
#> 2 versicolor 5.94 5.79 6.08 2.77 2.68 2.86 4.26 4.13
#> 3 virginica 6.59 6.41 6.77 2.97 2.88 3.07 5.55 5.40
#> # … with 4 more variables: Petal.Length_upper <dbl>, Petal.Width_mean <dbl>,
#> # Petal.Width_lower <dbl>, Petal.Width_upper <dbl>, and abbreviated variable
#> # names ¹Sepal.Length_mean, ²Sepal.Length_lower, ³Sepal.Length_upper,
#> # ⁴Sepal.Width_mean, ⁵Sepal.Width_lower, ⁶Sepal.Width_upper,
#> # ⁷Petal.Length_mean, ⁸Petal.Length_lower
更purrr-y的方法可能是将函数map用于嵌套的数据帧，以创建稍微长一点的数据输出:
iris |>
nest(data = -Species) |>
mutate(data = map(data, ~tibble(metric = names(.x), map_df(.x, mean_ci)))) |>
unnest(data)
#> # A tibble: 12 × 5
#> Species metric mean lower upper
#> <fct> <chr> <dbl> <dbl> <dbl>
#> 1 setosa Sepal.Length 5.01 4.91 5.11
#> 2 setosa Sepal.Width 3.43 3.32 3.54
#> 3 setosa Petal.Length 1.46 1.41 1.51
#> 4 setosa Petal.Width 0.246 0.216 0.276
#> 5 versicolor Sepal.Length 5.94 5.79 6.08
#> 6 versicolor Sepal.Width 2.77 2.68 2.86
#> 7 versicolor Petal.Length 4.26 4.13 4.39
#> 8 versicolor Petal.Width 1.33 1.27 1.38
#> 9 virginica Sepal.Length 6.59 6.41 6.77
#> 10 virginica Sepal.Width 2.97 2.88 3.07
#> 11 virginica Petal.Length 5.55 5.40 5.71
#> 12 virginica Petal.Width 2.03 1.95 2.10