vectorising complex dplyr statement in R

Question

I'm trying to work out the number of students taking a course, from those able to take a course, not all schools offer computing and different schools offer English, those able to take computing and english will differ. E.g. using the test data below, we'd have:

df <- read.csv(text="school, student, course, result
      URN1,stu1,comp,A
      URN1,stu2,comp,B
      URN1,stu3,comp,C
      URN1,stu1,Eng,D
      URN1,stu1,ICT,E
      URN2,stu4,comp,A
      URN1,stu1,ICT,B
      URN2,stu5,comp,C
      URN3,stu6,comp,D
      URN3,stu6,ICT,E
      URN4,stu7,Eng,E
      URN4,stu8,ICT,E
      URN4,stu8,Eng,E
      URN5,stu9,comp,E
      URN5,stu10,ICT,E")

[1] "comp taken by 58.3333333333333 % of possible students"

[1] "Eng taken by 33.3333333333333 % of possible students"

[1] "ICT taken by 38.4615384615385 % of possible students"

I have the following loop(boo!) to do this :

library(magrittr)
library(dplyr)

for(c in unique(df$course)){
  # c <- "comp"
  #get URNs of schools offering each course
  URNs <- df %>% filter(course == c) %>% distinct(school) %$% school
  #get number of students in each school offering course c
  num_possible <- df %>% filter(school %in% URNs) %>% summarise(n = n()) %$% n
  #get number of students taking course c 
  num_actual <- df %>% filter(course == c) %>% summarise(n = n()) %$% n

  # get % of students taking course from those who could theoretically take c
  print(paste(c, "taken by", (100 * num_actual/num_possible), "% of possible students"))
}

But want to vectorise it all, however, I can't get the num_possible into the same function as the num_actual:

df %>% group_by(course) %>% summarise(num_possible = somesubfunction(),
                                      num_actual = n())

somesubfunction() should return the number of students who could possibly take course c

Answer 1

This reproduces your expected output, but is likely to be wrong as you count students several times:

df %>%
  count(school,course) %>%
  left_join(df %>% count(school),by="school") %>%
  group_by(course) %>%
  summarize(num_actual = sum(n.x), pc = num_actual/sum(n.y))

# # A tibble: 3 x 3
#   course num_actual        pc
#   <fctr>      <int>     <dbl>
# 1   comp          7 0.5833333
# 2    Eng          3 0.3333333
# 3    ICT          5 0.3846154

And this would be the corrected answer:

df %>%
  count(school,course) %>%
  left_join(distinct(df[c("school","student")]) %>% count(school),by="school") %>%
  group_by(course) %>%
  summarize(num_actual = sum(n.x), pc = num_actual/sum(n.y))

# # A tibble: 3 x 3
#   course num_actual    pc
#   <fctr>      <int> <dbl>
# 1   comp          7 0.875
# 2    Eng          3 0.600
# 3    ICT          5 0.625

Answer 2

You are summarizing on different variable levels. The number of possible students is summarized on a school level, whereas the number of actual students is summarize on course level where the levels are not nested within.

Therefore I find it easier to create two different dataframe and then join them together, but I'll also provide a solution, where it is performed in one long call.

library(dplyr)

First summarize the data on a school level:

df_school <- df %>% 
  group_by(school) %>% 
  summarise(n_students_school = n_distinct(student))

df_school
# A tibble: 5 x 2
#   school n_students_school
#   <fct>              <int>
# 1 URN1                   3
# 2 URN2                   2
# 3 URN3                   1
# 4 URN4                   2
# 5 URN5                   2

To optain the possible course for each school, use a left_join with the original df, but only use the distinct combination of school and course :

df_possible <- df %>% 
  select(school, course) %>% 
  distinct() %>% 
  left_join(df_school, by = "school") %>% 
  group_by(course) %>% 
  summarise(n_possible = sum(n_students_school))

df_possible
# A tibble: 3 x 2
#   course n_possible
#   <fct>       <int>
# 1 comp            8
# 2 Eng             5
# 3 ICT             8

Calculate the actual number of students in each course:

df_actual <- df %>%
  group_by(course) %>% 
  summarise(n_actual = n_distinct(student))

df_actual
# A tibble: 3 x 2
#   course n_actual
#   <fct>     <int>
# 1 comp          7
# 2 Eng           3
# 3 ICT           4

Join the two dataframe to the final dataframe an calculated the percentage of students in the course:

df_final <- left_join(df_possible, df_actual, by = "course") %>%
  mutate(percentage = n_actual/n_possible)

df_final
# A tibble: 3 x 4
#   course n_possible n_actual percentage
#   <fct>       <int>    <int>      <dbl>
# 1 comp            8        7      0.875
# 2 Eng             5        3      0.600
# 3 ICT             8        4      0.500

Or in one long call with different groupings (credits go to @alistaire):

df %>% 
  group_by(school) %>% 
  group_by(school, course, n_students_school = n_distinct(student)) %>% 
  summarise(n_students_course = n_distinct(student)) %>% 
  group_by(course) %>% 
  summarise(n_possible = sum(n_students_school), 
            n_actual = sum(n_students_course), 
            percentage = n_actual / n_possible) 

Here by adding the n_students_school = n_distinct(student) to the group call it is created and then not deleted when summarising for the students per course.

Answer 3

If you're keen on trying something different from dplyr, you can try with data.table:

library(data.table)

setDT(df)[, nb_stu:=.N, by=course] # how many students by course
df[, nb_stu_ec:=length(unique(student)), by=school] # how many students per school (!: Edited to avoid counting some students twice if they take multiple courses)

# finally compute the number of student for a course 
# divided by the number of students in the schools that have this course (sprintf is only for formating the result):
df[, sprintf("%.2f", 100*first(nb_stu)/sum(nb_stu_ec[!duplicated(school)])), by=course]
#   course    V1
#1:   comp 87.50
#2:    Eng 60.00
#3:    ICT 62.50

---

Nota Bene: The same can be achieved in one step less, if computing the number of students per course only at the final step:

setDT(df)[, nb_stu_ec:=length(unique(student)), by=school]
df[, sprintf("%.2f", 100*(.N)/sum(nb_stu_ec[!duplicated(school)])), by=course]

#   course    V1
#1:   comp 87.50
#2:    Eng 60.00
#3:    ICT 62.50

Answer 4

Another short dplyr answer. A join on the course and school overviews, then a simple summarise.

library(dplyr)

left_join(
  count(df, course),
  df %>% group_by(school) %>% transmute(s = n(), course) %>% distinct()
) %>% 
  group_by(course) %>% 
  summarise(actual = first(n),
            total = sum(s),
            perc = actual / total * 100)

This reproduces your answers:

# A tibble: 3 x 4
  course actual total  perc
  <fct>   <int> <int> <dbl>
1 comp        7    12  58.3
2 Eng         3     9  33.3
3 ICT         5    13  38.5

But probably, you don't want to double-count students, so look for distinct ones:

left_join(
  count(df, course),
  df %>% group_by(school) %>% transmute(s = n_distinct(student), course) %>% distinct()
) %>% 
  group_by(course) %>% 
  summarise(actual = first(n),
            total = sum(s),
            perc = actual / total * 100)

# A tibble: 3 x 4
  course actual total  perc
  <fct>   <int> <int> <dbl>
1 comp        7     8  87.5
2 Eng         3     5  60.0
3 ICT         5     8  62.5

Answer 5

You could create a helper dataframe first, then map over it to get the number of possible students. Consider this

school_students <- df %>% 
  group_by(school) %>% 
  summarise(students = n(), courses = paste0(unique(course), collapse = ", "))

df %>% 
  count(course) %>%
  mutate(possible = map_int(as.character(course), 
    ~sum(school_students[str_detect(school_students$courses, .), "students"]))) %>%
  mutate(pct = n / possible * 100)

# A tibble: 3 x 4
  course     n possible   pct
  <fct>  <int>    <int> <dbl>
1 comp       7       12  58.3
2 Eng        3        9  33.3
3 ICT        5       13  38.5

Answer 6

I would first calculate a frequency table - you don't need to use raw data here:

ft <- with(df, as.matrix(table(school, course)))
# converting table to matrix to make it easier to handle

Then you can use either for or sapply or apply for dividing and multiplying:

sapply(1:ncol(ft), function(x) {
  k <- ft[, x]
  sum(k) / sum(ft[k!=0,])*100
})

Or (it's a simple problem, so using more than one line is a waste of lines):

apply(ft, 2, function(k) sum(k) / sum(ft[k!=0,]))*100
#      comp      Eng      ICT 
#  58.33333 33.33333 38.46154 

Answer 7

I know this has to be simplified, but here's one way to do this using dplyr:

# load necessary packages
library( dplyr )

# calculate stats
df %>%
  group_by( school ) %>%
  summarise( Total_Students        = n()
             , Offer_Comp          = "comp" %in% unique( course ) 
             , Offer_English       = "Eng" %in% unique( course )
             , Offer_ICT           = "ICT" %in% unique( course )
             , Comp_Taken          = ifelse( test = Offer_Comp == TRUE
                                             , yes = length( course[ which( course == "comp" ) ] )
                                             , no = NA 
                                             )
             , English_Taken       = ifelse( test = Offer_English == TRUE
                                             , yes = length( course[ which( course == "Eng" ) ] )
                                             , no = NA 
             )
             , ICT_Taken           = ifelse( test = Offer_ICT == TRUE
                                             , yes = length( course[ which( course == "ICT" ) ] )
                                             , no = NA 
             ) ) %>%
  summarise( Comp_Possible         = sum( Total_Students[ which( Offer_Comp == TRUE ) ] )
             , Comp_Taken_Count    = sum( Comp_Taken, na.rm = TRUE )
             , Comp_Taken_Per      = Comp_Taken_Count / Comp_Possible * 100
             , English_Possible    = sum( Total_Students[ which( Offer_English == TRUE ) ] )
             , English_Taken_Count = sum( English_Taken, na.rm = TRUE )
             , English_Taken_Per   = English_Taken_Count / English_Possible * 100
             , ICT_Possible        = sum( Total_Students[ which( Offer_ICT == TRUE ) ] )
             , ICT_Taken_Count     = sum( ICT_Taken, na.rm = TRUE )
             , ICT_Taken_Per       = ICT_Taken_Count / ICT_Possible * 100 )

# final output
# A tibble: 1 x 9
# Comp_Possible Comp_Taken_Count Comp_Taken_Per English_Possible English_Taken_Count English_Taken_Per ICT_Possible ICT_Taken_Count ICT_Taken_Per
#         <int>            <int>          <dbl>            <int>               <int>             <dbl>        <int>           <int>         <int>
# 1         12                7           58.3                9                   3              33.3           13               5           38.5

# end of script #