r中的嵌套dplyr循环

Question

我试图在 r 中做一个嵌套循环来做一些复杂的随机抽样。简要介绍一下我所拥有的以及我正在努力完成的工作。

我有一个包含 3 个变量的数据集（下面的示例代码）。每个变量都是 1 或 0。我想为每个变量采样不同的次数，但只针对“1”值。

例如，对于“A”列，我想随机抽取 1 个在该列中具有“1”值的唯一行。

我是循环新手，嵌套循环让我卡住了。

编辑：修复示例数据框。

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 似乎不喜欢下面的 sn-p，因为它不接受 filter 函数的下标。

filter([[j]]==1)

Answer 1

我创建了一个规范数据框spec，它结合了groups 和high_count。 有了这个，我可以使用lapply 和 curly curl 运算符制定解决方案。首先，我计算出 sample_size 并将其用于sample_n 函数调用。

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)
})

结果：

> 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

可以结合：

result <- bind_rows(result_list)