Nested dplyr Loop in r

Viewed 478

I am trying to do a nested loop in r to do some complex random sampling. A quick rundown of what I have and what I am trying to accomplish.

I have a dataset (example code below) with 3 variables. Each variable is a 1 or a 0. I want to sample a different number of times for each variable, but only for the '1' values.

So for example, for column 'A', I want to sample 1 random unique row that has a '1' value in the column.

I am new to loops, and the nested loop has me stuck.

edit: fixed the sample dataframe.

library(tidyverse)

###create sample data set

id<-c('l','m','n','o','p')

A<-c(0,1,1,1,1)

B<-c(1,1,1,0,1)

C<-c(1,1,1,0,1)

RISK_LEVEL<-c('3 - Elevated', '3 - Elevated', '3 - Elevated', '3 - Elevated', '3 - Elevated')

data<-as.data.frame(id, A, B, C, RISK_LEVEL)


#list with number of samples I want to take from each column
high_count<-c(1,3,2)

#list of columns I want to sample from
groups<-c('A','B','C')

#create blank dataframe to house output
high_samp<-list(matrix(,nrow=5,ncol=5))

###nested loop
for (j in 1:length(groups)) {

  for (i in 1:length(high_count)) {

high_samp[[i]]<-data %>%

  filter(RISK_LEVEL=='3 - Elevated') %>%

  filter([[j]]==1) %>%

  sample_n(high_count[[i]])

}
}

#turns list of dataframes into one dataframe
high_samp<-bind_rows(high_samp)

dplyr doesn't seem to like the snippet below, as it won't accept the subscript on the filter function.

filter([[j]]==1)
1 Answers

I created a specification data frame spec which combines groups and high_count. With that, I can work out a solution using lapply and the curly curly operator. First, I work out the sample_size and use that for the sample_n function call.

library(dplyr)

###create sample data set
id <- c('l','m','n','o','p')
A <- c(0,1,1,1,1)
B <- c(1,1,1,0,1)
C <- c(1,1,1,0,1)
RISK_LEVEL <- c('3 - Elevated', '3 - Elevated', '3 - Elevated', '3 - Elevated', '3 - Elevated')
data <- data.frame(id, A, B, C, RISK_LEVEL)

high_count<-c(1,3,2)
groups<-c('A','B','C')
spec <- data.frame(groups = groups, high_count = high_count, stringsAsFactors = FALSE)

result_list <- lapply(spec$groups, function(x) { 
  sample_size <- spec %>%
    filter(groups == {{x}}) %>%
    .$high_count
  result <- data %>% 
    filter(get(x) == 1) %>%
    sample_n(sample_size)
})

Which results in:

> result_list
[[1]]
  id A B C   RISK_LEVEL
1  p 1 1 1 3 - Elevated

[[2]]
  id A B C   RISK_LEVEL
1  m 1 1 1 3 - Elevated
2  p 1 1 1 3 - Elevated
3  l 0 1 1 3 - Elevated

[[3]]
  id A B C   RISK_LEVEL
1  m 1 1 1 3 - Elevated
2  l 0 1 1 3 - Elevated

Which can be combined with:

result <- bind_rows(result_list)
Related