Using a vector to index a data.frame in R

Viewed 188

I have a data.frame which contains an ID number and scaled responses from a survey:

df(responses)

ID    X1    X2    X3    X4
A1    1     1     2     1
B2    0     1     3     0
C3    3     3     2     0

I also have a data.frame that is used as a key:

df(key)

X    Y    Z
2    1    1
3    2    2
4    3    4

I am trying to write a script that will calculate an X, Y, and Z score for each participant, where the X score is the sum of the responses for the questions listed under X in the key.

e.g. the X score for participant A1 would be equal to the sum of X2, X3, and X4in the A1 row (1+2+1 = 4).

The desired output is:

df(output)

ID    X    Y    Z
A1    4    4    3
B2    4    4    1
C3    5    8    6

However, I am currently struggling to be able to index the data.frame responses using the values in key. My current state is:

#store scale names
scales <- c(colnames(key))
#loop over every participant
for (i in responses$ID){
    #create temporary data.frame with only participant "i"s responses
    data <- subset(responses, ID == i)
    #loop over each scale and store the relevant response numbers
    for (s in scales){
        relevantResponses <- scales[c(s)]
        #create a temporary storage for the total of each scale
        runningScore <- 0
        #index each response and add it to the total
        for (r in relevantResponses){
             runningScore <- runningScore + data[1,r]
  

However I am getting the error:

Error in `[.data.frame`(data, 1, r) : 
  undefined columns selected

Is there a better way of doing the indexing rather than the nested loops?

2 Answers

We can use rowSums loop over the key data columns with lapply, extract the 'responses' numeric columns based on the index, get the rowSums convert the list to data.frame and cbind with the first column of 'responses'

cbind(responses[1], data.frame(lapply(key, 
     function(x) rowSums(responses[-1][, na.omit(x)], na.rm = TRUE))))

-output

#  ID X Y Z
#1 A1 4 4 3
#2 B2 4 4 1
#3 C3 5 8 6

Or with tidyverse

imap(key, ~ responses %>%
     transmute(ID, !!.y :=  rowSums(select(cur_data()[-1], na.omit(.x)),
          na.rm = TRUE))) %>% 
     reduce(inner_join)

-output

#  ID X Y Z
#1 A1 4 4 3
#2 B2 4 4 1
#3 C3 5 8 6

Or another option is mutate with across

key %>%
   mutate(across(everything(), 
       ~ rowSums(responses[-1][na.omit(.)], na.rm = TRUE)), 
          ID = responses$ID, .before = 1)
#  ID X Y Z
#1 A1 4 4 3
#2 B2 4 4 1
#3 C3 5 8 6

data

responses <- structure(list(ID = c("A1", "B2", "C3"), X1 = c(1L, 0L, 3L), 
    X2 = c(1L, 1L, 3L), X3 = c(2L, 3L, 2L), X4 = c(1L, 0L, 0L
    )), class = "data.frame", row.names = c(NA, -3L))

key <- structure(list(X = 2:4, Y = 1:3, Z = c(1L, 2L, 4L)), class = "data.frame",
   row.names = c(NA, 
-3L))

Here is another way of dealing with this problem. I just wanted to challenge myself with my favorite choice of solution and this is not as concise and brilliant as the ones proposed by dear @akrun. Here is to him who taught me how to do it with with purrr family of functions:

library(dplyr)
library(purrr)

responses %>% 
  select(X1:X4) %>% 
  pmap_dfr(., ~ map_dfc(1:length(key), function(x) sum(c(...)[key[, x]]))) %>%
  bind_cols(responses$ID) %>%
  set_names(c("x", "y", "z", "ID")) %>% 
  relocate(ID)

  ID        x     y     z
  <chr> <int> <int> <int>
1 A1        4     4     3
2 B2        4     4     1
3 C3        5     8     6

There are two more concise approaches proposed by dear @akrun I would like to add to here. One with rowSums function and the other with reduce from purrr package. Just keep in mind that when we apply + function with reduce on a data frame, it will be applied on every row and collapsed it into a single element:

map_dfc(key, ~ responses[-1][.x] %>% rowSums())

# A tibble: 3 x 3
      X     Y     Z
  <dbl> <dbl> <dbl>
1     4     4     3
2     4     4     1
3     5     8     6

And with reduce:

map_dfc(key, ~ responses[-1][.x] %>% reduce(`+`))

# A tibble: 3 x 3
      X     Y     Z
  <int> <int> <int>
1     4     4     3
2     4     4     1
3     5     8     6
Related