How to compute percentage of response by option using R?

Viewed 343

Here is an example of my data frame:

    Question Student Option
1          1       1      4
2          1       2      1
3          1       3      1
4          1       4      5
5          2       1      3
6          2       2      2
7          2       3      2
8          2       4      1

I am trying to compute the percentage of response by option 0-5 for each question. I manage to compute the percentage of response for each option by question like this:

Global_Response <- group_by(ExamData,Question) %>% #group data by question
  summarise(Global_0 = length(which(Option=="0"))/length(Option)*100, #Percentage of response option "0" by question
        Global_1 = length(which(Option=="1"))/length(Option)*100,
        Global_2 = length(which(Option=="2"))/length(Option)*100,
        Global_3 = length(which(Option=="3"))/length(Option)*100,
        Global_4 = length(which(Option=="4"))/length(Option)*100,
        Global_5 = length(which(Option=="5"))/length(Option)*100)

In the end, I would like to have a new data frame with the percentage of response for each option. Similar to this example:

Question Global_0 Global_1 Global_2 Global_3 Global_4 Global_5
  <int>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
   1        0       50.0      0         0       25.0     25.0
   2        0       25.0      50.0     25.0       0       0  

Now, I would like to do the same thing but with a few lines of code. I have tried a for loop, but it didn't work. I don't know what would be more appropriate to do what I want.

3 Answers

maybe this could help ...

df <- dplyr::tibble(
  Question=c(1,1,1,1,1,1,2,3),
  Student=c(1,2,3,4,5,6,1,1),
  Option=c(4,1,1,3,4,2,5,1)
) 

global_response <- df %>%
  dplyr::count(Question,Option) %>%
  dplyr::group_by(Question) %>%
  dplyr::mutate(pct=n/sum(n)*100) %>%
  dplyr::ungroup()

    # A tibble: 6 x 4
  Question Option     n   pct
     <dbl>  <dbl> <int> <dbl>
1        1      1     2  33.3
2        1      2     1  16.7
3        1      3     1  16.7
4        1      4     2  33.3
5        2      5     1 100  
6        3      1     1 100  

and if you want it in a wider format, just do

global_response %>%
  tidyr::pivot_wider(id_cols=Question,
                     names_from=Option,
                     values_from=pct,
                     values_fill=list(pct=0))

# A tibble: 3 x 6
  Question   `1`   `2`   `3`   `4`   `5`
     <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1        1  33.3  16.7  16.7  33.3     0
2        2   0     0     0     0     100
3        3 100     0     0     0       0

In base R you can use

with(ExamData, prop.table(table(Question, Option), margin = 1)*100)
#         Option
# Question   1   4   5
#        1   0 100   0
#        2   0   0 100
#        3 100   0   0

and, if you want to obtain a tibble similar to yours, you can do

dplyr::as_tibble(with(ExamData, prop.table(table(Question, Option), margin = 1)*100)) %>% 
  tidyr::pivot_wider(Question, names_from = Option, values_from = n, names_glue = "Global_{Option}")
# A tibble: 3 x 4
#   Question Global_1 Global_4 Global_5
#   <chr>       <dbl>    <dbl>    <dbl>
# 1 1               0      100        0
# 2 2               0        0      100
# 3 3             100        0        0

The trick is to transform your Option variable from numeric to character before tallying. Otherwise, the numeric values just get added up, and the counts will be all wrong.

Here's a full solution below:

set.seed(2)

library(dplyr)
library(tidyr)

df <- data.frame(ExamData = rep(1:2, each = 8), 
                 Question = rep(1:4, 4), 
                 Student = rep(1:4, 2, each = 2), 
                 Option = sample(1:5, 16, replace = TRUE), 
                 stringsAsFactors = FALSE)

head(df)

#   ExamData Question Student Option
# 1        1        1       1      5
# 2        1        2       1      1
# 3        1        3       2      5
# 4        1        4       2      1
# 5        1        1       3      4
# 6        1        2       3      5

df %>% 
  mutate(Option = as.character(Option)) %>%
  group_by(Question, Option) %>%
  tally() %>%
  mutate(n = (n/sum(n))*100) %>%
  pivot_wider(id_cols = Question, 
              names_from = Option, 
              values_from = n, 
              values_fill = list(n = 0), 
              names_prefix = "Global_")

# # A tibble: 4 x 6
# # Groups:   Question [4]
#   Question Global_3 Global_4 Global_5 Global_1 Global_2
#      <int>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
# 1        1       50       25       25        0        0
# 2        2        0        0       25       75        0
# 3        3       25        0       25       50        0
# 4        4        0       25        0       25       50

UPDATED SOLUTION for cases where one of the Options hasn't been invoked at all:

Say the results from df are stored in df1, then something like this could be used to add the missing Global_ columns:

df1 <- df %>% 
  mutate(Option = as.character(Option)) %>%
  group_by(Question, Option) %>%
  tally() %>%
  mutate(n = (n/sum(n))*100) %>%
  pivot_wider(id_cols = Question, 
              names_from = Option, 
              values_from = n, 
              values_fill = list(n = 0), 
              names_prefix = "Global_")

df1

# # A tibble: 4 x 6
# # Groups:   Question [4]
#   Question Global_3 Global_4 Global_5 Global_1 Global_2
#      <int>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
# 1        1       50       25       25        0        0
# 2        2        0        0       25       75        0
# 3        3       25        0       25       50        0
# 4        4        0       25        0       25       50

#----



library(stringr)

#df1 is the processed df from above stored
#First get rid of the grouping effects
df1 <- ungroup(df1)


#Eliminating the column Global_5 for demonstration
df1 %<>% select(-Global_5)

df1

# A tibble: 4 x 5
#   Question Global_3 Global_4 Global_1 Global_2
#      <int>    <dbl>    <dbl>    <dbl>    <dbl>
# 1        1       50       25        0        0
# 2        2        0        0       75        0
# 3        3       25        0       50        0
# 4        4        0       25       25       50

#----



#Old way of getting the Global_ values
#vdf1 <- str_extract(names(df1[,-1]), "(?<=_).+")
#vdf1 #Extract the Option numbers

#New way, columns are chosen automatically
vdf1 <- df1 %>% 
  select(which(str_detect(colnames(df1), "Global_"))) %>% 
  names() %>% str_extract(., "(?<=_).+") %>% as.numeric()
vdf1
# [1] 3 4 1 2



mcols <- which(!(1:5 %in% vdf1))
mcols #See which of the 5 are missing
# [1] 5



#Looping through to add the missing columns
#The missing columns are populated with zeroes
#They are initially named "newcol"(s)
#Then renamed to Global_<value_from_mcols>
for(i in length(mcols)){
  
  df1$newcol <- rep(0, nrow(df1))
  
  #This commented out version is unnecessarily complex
  #names(df1) <- c(names(df1)[1:length(names(df1))-1], paste0("Global_", mcols[i]))
  
  #This is easier
  colnames(df1)[colnames(df1) == "newcol"] <- paste0("Global_", mcols[i])
  
}

df1

# # A tibble: 4 x 6
#   Question Global_3 Global_4 Global_1 Global_2 Global_5
#      <int>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
# 1        1       50       25        0        0        0
# 2        2        0        0       75        0        0
# 3        3       25        0       50        0        0
# 4        4        0       25       25       50        0
Related