如何用嵌套循环存储双因子变量组合的计算结果

现有数据与函数 #

数据定义 #

df <- data.frame(SPECIES = as.factor(c(rep("SWAN",10), rep("DUCK",4), rep("GOOS",12),
                             rep("PASS",9), rep("FALC",10))),
                 DRAINAGE = as.factor(c(rep(c("Central", "Upper", "West"),15))),
                 CATCH_QTY = c(1,1,2,5,6,1,2,1,1,1,1,1,3,1,1,2,1,1,2,2,
                               rep(1,25)),
                 TAGGED = c(rep("T",6),NA,"T","T",NA,rep("T",10),NA,NA,
                            rep("T",9),NA,"T","T","T","T",NA,rep("T",7),NA),
                 RECAP = c(rep(NA,6),"RC",NA,NA,"RC",rep(NA,10),"RC","RC",
                            rep(NA,9),"RC",NA,NA,NA,NA,"RC",rep(NA,7),"RC"))

自定义计算函数 #

myfunction <- function(dat, yr, spp, drain){
  dat <- dat %>% filter(SPECIES == spp, DRAINAGE == drain)

    estimatea <<-
      dat %>%
      summarise(NumCaught = sum(CATCH_QTY, na.rm = T),
            NewTags = sum(!is.na(TAGGED)), 
            Recaps = sum(!is.na(RECAP)),
            TotTags = sum(NewTags+Recaps))
    
    dataTest1 <- cbind(yr, spp, drain, estimatea$NumCaught, estimatea$NewTags,
                       estimatea$Recaps, estimatea$TotTags)
}

尝试的方法及报错 #

嵌套循环尝试 #

第一种循环写法：

out <- list()

for (i in seq_along(levels(df$SPECIES))) {
  for (j in seq_along(levels(df$DRAINAGE))) {
    out[i,j] <- myfunction(df, "2023", i, j)
  }
}

报错：

Error in out[i, j] <- myfunction(df, "2023", i, j) :
incorrect number of subscripts on matrix

调整索引后的循环写法：

for (i in seq_along(levels(df$SPECIES))) {
  for (j in seq_along(levels(df$DRAINAGE))) {
    out[i+1,j+1] <- myfunction(df, "2023", i, j)
  }
}

报错信息同上。

非循环方法尝试 #

combos <- expand.grid(df$SPECIES, df$DRAINAGE) %>% distinct() %>%
  drop_na() %>% rename(spp = Var1, drain = Var2)
test <- myfunction(df, "2023", combos$spp, combos$drain) #结果不正确

sapply(combos$spp, function(x) mapply(myfunction,x,combos$drain))
apply(combos, 2, FUN = myfunction)

报错：

Error in UseMethod("filter") :
no applicable method for 'filter' applied to an object of class "character"

理想输出格式 #

desired_out <- data.frame(yr = rep("2023",3),
                          spp = c("DUCK", "DUCK", "GOOS"),
                          drain = c("West", "Central", "Upper"),
                          V4 = c(1,3,4),
                          V5 = c(1,1,3),
                          v6 = c(0,0,1),
                          V7 = c(1,1,4))

解决方案 #

第一步：修正自定义函数 #

原函数存在全局赋值冗余、返回矩阵而非数据框、TotTags计算冗余三个问题，修正后：

library(dplyr)

myfunction <- function(dat, yr, spp, drain){
  dat %>%
    filter(SPECIES == spp, DRAINAGE == drain) %>%
    summarise(yr = yr,
              spp = spp,
              drain = drain,
              NumCaught = sum(CATCH_QTY, na.rm = TRUE),
              NewTags = sum(!is.na(TAGGED)), 
              Recaps = sum(!is.na(RECAP)),
              TotTags = NewTags + Recaps)
}

方法一：修正嵌套循环 #

直接遍历因子水平值而非索引，用列表存储结果后合并：

# 获取所有因子水平
spp_levels <- levels(df$SPECIES)
drain_levels <- levels(df$DRAINAGE)

out_list <- list()
counter <- 1

for (spp in spp_levels) {
  for (drain in drain_levels) {
    # 跳过无数据的组合（可选）
    if(nrow(filter(df, SPECIES == spp, DRAINAGE == drain)) == 0) next
    out_list[[counter]] <- myfunction(df, "2023", spp, drain)
    counter <- counter + 1
  }
}

# 合并为最终数据框
final_out <- bind_rows(out_list)

方法二：用purrr实现无循环映射 #

生成所有有效组合后批量调用函数：

library(purrr)
library(dplyr)

# 生成所有非空的因子组合
combos <- expand.grid(spp = levels(df$SPECIES), 
                      drain = levels(df$DRAINAGE)) %>%
  filter(pmap_lgl(., ~nrow(filter(df, SPECIES == ..1, DRAINAGE == ..2)) > 0))

# 批量计算并合并结果
final_out <- pmap_dfr(combos, ~myfunction(df, "2023", ..1, ..2))

方法三：直接用dplyr分组计算（最简洁） #

无需循环或自定义函数，直接分组汇总：

final_out <- df %>%
  group_by(SPECIES, DRAINAGE) %>%
  summarise(yr = "2023",
            NumCaught = sum(CATCH_QTY, na.rm = TRUE),
            NewTags = sum(!is.na(TAGGED)), 
            Recaps = sum(!is.na(RECAP)),
            TotTags = NewTags + Recaps) %>%
  rename(spp = SPECIES, drain = DRAINAGE) %>%
  ungroup()

内容的提问来源于stack exchange，提问作者payne