Using tidyverse to get descriptive results with nest and then count how many observations we have matching these criteria

user_5893454 0
Viewed 72

Let's say I have a dataset from a regular school in which students from different living areas are tested in math, English, and science. You need to do a retest if your score is 1SD below the mean and you'll fail if your score is 2SD below the mean.

I can easily compute the means, standard deviation, and these cutoffs. I'm using the nest from the tidyverse package. However, I would like to discover how many students were 1SD below and 2SD below the mean.

image 1

However, I don't know how to do these count calculations to these results in an easy way.

Please check the dataset and the code I'm using to achieve the descriptive results:

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()
nest purrr dplyr tidyverse datatable
2 Answers

We can use data column to see how many students are below one and two sd.

adding this two lines to the mutate call:

    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

Created on 2021-12-25 by the reprex package (v2.0.1)

user_111687660

You could do something like this.

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

Output

# 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

Then, if you would like to visualize the data in a wider format, then you could do something like this.

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)

Output

# 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
user_152931910
Related