creating variables for proportions in each category, over multiple variables

Question

I want to create a data frame with columns for the proportion of observations in each category, much like this:

library(tidyverse)
mtcars %>%
  group_by(am) %>%
  summarise(gear3 = sum(gear == 3)/n(), 
            gear4 = sum(gear == 4)/n(), 
            gear5 = sum(gear == 5)/n(), 
            cyl4 = sum(cyl == 4)/n(),
            cyl6 = sum(cyl == 6)/n(),
            cyl8 = sum(cyl == 8)/n())

# # A tibble: 2 x 7
#      am gear3 gear4 gear5  cyl4  cyl6  cyl8
#   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
# 1     0 0.789 0.211 0     0.158 0.211 0.632
# 2     1 0     0.615 0.385 0.615 0.231 0.154

I am looking for way to this without manually naming the new summary variables?

There seems to be a few questions, such as here, related to creating a proportions for single variables, which i could replicate for each variable, pivot and and then combine but it will become tedious in my application - i am trying to build the data frame for many variables

mtcars %>%
  group_by(am, gear) %>%
  summarise(n = n()) %>%
  mutate(freq = n / sum(n))
# # A tibble: 4 x 4
# # Groups:   am [2]
#      am  gear     n  freq
#   <dbl> <dbl> <int> <dbl>
# 1     0     3    15 0.789
# 2     0     4     4 0.211
# 3     1     4     8 0.615
# 4     1     5     5 0.385

mtcars %>%
  group_by(am, cyl) %>%
  summarise(n = n()) %>%
  mutate(freq = n / sum(n))
# # A tibble: 6 x 4
# # Groups:   am [2]
#      am   cyl     n  freq
#   <dbl> <dbl> <int> <dbl>
# 1     0     4     3 0.158
# 2     0     6     4 0.211
# 3     0     8    12 0.632
# 4     1     4     8 0.615
# 5     1     6     3 0.231
# 6     1     8     2 0.154

user12728748 · Answer 1 · 2020-05-13T14:12:20.307

Here is one solution:

library(dplyr)

freqPairs <- function(df, first, second){
  pairs <- as.list(data.frame(t(expand.grid(first, second))))
  res <- lapply(pairs, function(z) df %>%
                  group_by(!!sym(z[1]), !!sym(z[2])) %>%
                  summarise(n = n()) %>%
                  mutate(freq = n / sum(n)) %>% 
                  {colnames(.)[1:2] = c("Var1", "Var2"); .} %>% 
                  ungroup())
  setNames(res, unlist(lapply(pairs, paste, collapse="_vs_")))
}

bind_rows(freqPairs(mtcars, first=c("am"), second=c("cyl", "gear")), .id = "comparison")
#> # A tibble: 10 x 5
#>    comparison  Var1  Var2     n  freq
#>    <chr>      <dbl> <dbl> <int> <dbl>
#>  1 am_vs_cyl      0     4     3 0.158
#>  2 am_vs_cyl      0     6     4 0.211
#>  3 am_vs_cyl      0     8    12 0.632
#>  4 am_vs_cyl      1     4     8 0.615
#>  5 am_vs_cyl      1     6     3 0.231
#>  6 am_vs_cyl      1     8     2 0.154
#>  7 am_vs_gear     0     3    15 0.789
#>  8 am_vs_gear     0     4     4 0.211
#>  9 am_vs_gear     1     4     8 0.615
#> 10 am_vs_gear     1     5     5 0.385

^{Created on 2020-05-13 by the reprex package (v0.3.0)}

You can always recover the names of Var1 and Var2 from the comparison column, e.g. by splitting that string. Example:

library(data.table)
res <- bind_rows(freqPairs(mtcars, first=c("am"), second=c("cyl", "gear")), .id = "comparison")
data.table(res)[, c("Variable1", "Variable2") := tstrsplit(comparison, "_vs_")][]
#>     comparison Var1 Var2  n      freq Variable1 Variable2
#>  1:  am_vs_cyl    0    4  3 0.1578947        am       cyl
#>  2:  am_vs_cyl    0    6  4 0.2105263        am       cyl
#>  3:  am_vs_cyl    0    8 12 0.6315789        am       cyl
#>  4:  am_vs_cyl    1    4  8 0.6153846        am       cyl
#>  5:  am_vs_cyl    1    6  3 0.2307692        am       cyl
#>  6:  am_vs_cyl    1    8  2 0.1538462        am       cyl
#>  7: am_vs_gear    0    3 15 0.7894737        am      gear
#>  8: am_vs_gear    0    4  4 0.2105263        am      gear
#>  9: am_vs_gear    1    4  8 0.6153846        am      gear
#> 10: am_vs_gear    1    5  5 0.3846154        am      gear

Note: If you really want all possible pairs in both orders, you could use something like:

pairs <- c(combn(colnames(mtcars), 2, simplify=FALSE),
lapply(combn(colnames(mtcars), 2, simplify=FALSE), rev))

guyabel · Accepted Answer · 2020-05-15T01:07:14.227

Figured out a way using map() in purrr

First, a function to calculate a named vector of proportions

prop <- function(v){
  n <- match.call() %>%
    as.character() %>%
    .[2] %>%
    str_extract(pattern = "(?<=\\$)(.*)")

  table(v) %>% 
    `/`(sum(.)) %>%
    as.matrix() %>%
    t() %>%
    as_tibble() %>%
    set_names(paste0(n, colnames(.)))
}
prop(v = mtcars$gear) 
# # A tibble: 1 x 3
#   gear3 gear4 gear5
#   <dbl> <dbl> <dbl>
# 1 0.469 0.375 0.156

Then using map() to apply the function to each group, one variable at a time

mtcars %>%
  group_nest(am) %>%
  mutate(p_gear = map(.x = data, .f = ~prop(.x$gear)),
         p_cyl = map(.x = data, .f = ~prop(.x$cyl))) %>%
  unnest(c(p_gear, p_cyl)) %>%
  select(-data)
# # A tibble: 2 x 7
#      am  gear3 gear4  gear5  cyl4  cyl6  cyl8
#   <dbl>  <dbl> <dbl>  <dbl> <dbl> <dbl> <dbl>
# 1     0  0.789 0.211 NA     0.158 0.211 0.632
# 2     1 NA     0.615  0.385 0.615 0.231 0.154

A further example, including replacing NA with zeros

mtcars %>%
  group_nest(carb) %>%
  mutate(p_gear = map(.x = data, .f = ~prop(.x$gear)),
         p_cyl = map(.x = data, .f = ~prop(.x$cyl)),
         p_vs = map(.x = data, .f = ~prop(.x$vs))) %>%
  unnest(c(p_gear, p_cyl, p_vs)) %>%
  select(-data) %>%
  mutate_all(~ifelse(is.na(.), 0, .))
# # A tibble: 6 x 9
#    carb gear3 gear4 gear5  cyl4  cyl6  cyl8   vs1   vs0
#   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
# 1     1 0.429 0.571   0   0.714 0.286   0     1     0  
# 2     2 0.4   0.4     0.2 0.6   0       0.4   0.5   0.5
# 3     3 1     0       0   0     0       1     0     1  
# 4     4 0.5   0.4     0.1 0     0.4     0.6   0.2   0.8
# 5     6 0     0       1   0     1       0     0     1  
# 6     8 0     0       1   0     0       1     0     1

creating variables for proportions in each category, over multiple variables

2 Answers2