使用 tidyverse 通过 nest 获得描述性结果，然后计算我们有多少观察符合这些条件

问题描述 投票：0回答：2

假设我有一个来自普通学校的数据集，来自不同生活地区的学生在数学、英语和科学方面进行了测试。如果你的分数低于平均值 1SD，你需要重新测试，如果你的分数低于平均值 2SD，你就会失败。

我可以轻松计算均值、标准差和这些截断值。我正在使用 

nest
包中的 
tidyverse
。但是，我想知道有多少学生低于平均水平 1SD 和低于平均水平 2SD。

但是，我不知道如何以简单的方式对这些结果进行

count
计算。

请检查数据集和我用来实现描述性结果的代码：

library(tidyverse)
set.seed(123)
ds <- data.frame(quest = c(2,4,6),
                 living_area = c("rural","urban","mixed"),
                 math_sum = rnorm(120, 10,1),
                 english_sum = rnorm(120, 10,1),
                 science_sum = rnorm(120, 10,1)
)

ds %>% 
  select(quest, ends_with("sum")) %>% #get variable names
  pivot_longer(-quest) %>% #tranform into  long format
  nest_by(quest, name) %>% #nest
  mutate(
    n = map_dbl(data, ~nrow(data.frame(.))), #compute sample size
    mean = map_dbl(data, ~mean(.)), #get the means
    sd = map_dbl(data, ~sd(.)), #get sd
    below = mean-sd, #1 below
    failed = mean-2*sd)

ds %>% 
  filter(quest == 2 & english_sum <= 9.19) %>% nrow()

ds %>% 
  filter(quest == 2 & english_sum <= 9.39) %>% nrow()

ds %>% 
  filter(quest == 2 & english_sum <= 8.73) %>% nrow()
r dplyr purrr
2个回答
2
投票

我们可以使用

data
列来查看有多少学生低于一和二标准差。

将这两行添加到 

mutate
调用中：

    oneSd_below = sum((mean - sd) > data[[1]]),
    twoSd_below = sum((mean - 2*sd) > data[[1]])

library(tidyverse)

set.seed(123)

ds <- data.frame(quest = c(2,4,6),
                 living_area = c("rural","urban","mixed"),
                 math_sum = rnorm(120, 10,1),
                 english_sum = rnorm(120, 10,1),
                 science_sum = rnorm(120, 10,1)
) %>% as_tibble()

ds %>%
  select(quest, ends_with("sum")) %>% #get variable names
  pivot_longer(-quest) %>% #tranform into  long format
  nest_by(quest, name) %>% 
  mutate(
    n = map_dbl(data, ~ nrow(data.frame(.))),
    #compute sample size
    mean = map_dbl(data, ~ mean(.)),
    #get the means
    sd = map_dbl(data, ~ sd(.)),
    #get sd
    below = mean - sd,
    #1 below
    failed = mean - 2 * sd,
    oneSd_below = sum((mean - sd) > data[[1]]),
    twoSd_below = sum((mean - 2*sd) > data[[1]])
  )
#> # A tibble: 9 × 10
#> # Rowwise:  quest, name
#>   quest name         data     n  mean    sd below failed oneSd_below twoSd_below
#>   <dbl> <chr>   <list<ti> <dbl> <dbl> <dbl> <dbl>  <dbl>       <int>       <int>
#> 1     2 englis…  [40 × 1]    40 10.0  0.839  9.19   8.35           6           0
#> 2     2 math_s…  [40 × 1]    40 10.2  0.805  9.39   8.59           7           0
#> 3     2 scienc…  [40 × 1]    40  9.92 1.19   8.73   7.54           8           0
#> 4     4 englis…  [40 × 1]    40 10.0  1.08   8.94   7.87           6           0
#> 5     4 math_s…  [40 × 1]    40  9.90 0.870  9.03   8.16           6           0
#> 6     4 scienc…  [40 × 1]    40  9.96 0.882  9.07   8.19           6           1
#> 7     6 englis…  [40 × 1]    40  9.87 1.03   8.83   7.80           7           0
#> 8     6 math_s…  [40 × 1]    40  9.95 0.992  8.96   7.96           6           1
#> 9     6 scienc…  [40 × 1]    40 10.4  0.967  9.41   8.44           5           1

由 reprex 包 (v2.0.1) 于 2021-12-25 创建

1
投票

你可以做这样的事情。

library(tidyverse)

ds_sum <- ds %>%
  select(quest, ends_with("sum")) %>% #get variable names
  pivot_longer(-quest) %>% #tranform into  long format
  nest_by(quest, name) %>% #nest
  mutate(
    n = map_dbl(data, ~ nrow(data.frame(.))),
    #compute sample size
    mean = map_dbl(data, ~ mean(.)),
    #get the means
    sd = map_dbl(data, ~ sd(.)),
    #get sd
    below = mean - sd,
    #1 below
    failed = mean - 2 * sd
  ) %>%
  unnest(data) %>%
  rowwise() %>%
  mutate(
    `1sd_below` = ifelse(value <= below & value > failed, 1, 0),
    `2sd_below` = ifelse(value <= failed, 1, 0)
  ) %>%
  select(-value) %>%
  ungroup() %>%
  group_by(across(-c(`1sd_below`, `2sd_below`))) %>%
  summarise(across(c(`1sd_below`, `2sd_below`), sum))

输出

# A tibble: 9 × 9
  quest name            n  mean    sd below failed `1sd_below` `2sd_below`
  <dbl> <chr>       <dbl> <dbl> <dbl> <dbl>  <dbl>       <dbl>       <dbl>
1     2 english_sum    40 10.0  0.839  9.19   8.35           6           0
2     2 math_sum       40 10.2  0.805  9.39   8.59           7           0
3     2 science_sum    40  9.92 1.19   8.73   7.54           8           0
4     4 english_sum    40 10.0  1.08   8.94   7.87           6           0
5     4 math_sum       40  9.90 0.870  9.03   8.16           6           0
6     4 science_sum    40  9.96 0.882  9.07   8.19           5           1
7     6 english_sum    40  9.87 1.03   8.83   7.80           7           0
8     6 math_sum       40  9.95 0.992  8.96   7.96           5           1
9     6 science_sum    40 10.4  0.967  9.41   8.44           4           1

然后，如果您想以更宽的格式可视化数据，那么您可以这样做。

ds_sum %>%
  mutate(row = row_number()) %>%
  select(row, quest, name, `1sd_below`, `2sd_below`) %>%
  pivot_longer(cols = `1sd_below`:`2sd_below`, names_to = 'SD') %>%
  unite("new_name", name, SD, sep = "_") %>%
  pivot_wider(names_from = "new_name", values_from = "value") %>%
  select(-row) %>%
  replace(is.na(.), 0)

输出

# A tibble: 9 × 7
  quest english_sum_1sd_below english_sum_2sd_below math_sum_1sd_below math_sum_2sd_below science_sum_1sd_below science_sum_2sd_below
  <dbl>                 <dbl>                 <dbl>              <dbl>              <dbl>                 <dbl>                 <dbl>
1     2                     6                     0                  0                  0                     0                     0
2     2                     0                     0                  7                  0                     0                     0
3     2                     0                     0                  0                  0                     8                     0
4     4                     6                     0                  0                  0                     0                     0
5     4                     0                     0                  6                  0                     0                     0
6     4                     0                     0                  0                  0                     5                     1
7     6                     7                     0                  0                  0                     0                     0
8     6                     0                     0                  5                  1                     0                     0
9     6                     0                     0                  0                  0                     4                     1
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.