R函数如何同时处理错误与警告并自动识别EventType？

我编写的cohort_entry函数接收IndexEvent和IndexEventType两个参数。当用户未指定IndexEventType时，程序需要自动尝试所有可选的EventType，筛选出既不返回错误也不返回警告的类型（不匹配的EventType会抛出错误或警告）。

目前的问题是无法同时捕获错误与警告：使用tryCatch时只能先检查错误，无错误再检查警告，通过嵌套循环寻找符合条件的EventType，但我需要实现同时检测错误和警告的逻辑，而非分开处理。

library(Capr)
cohort_entry <- function(IndexEventType = NA_character_,
                         IndexEvent){
  
  if(is.na(IndexEventType)) {
    e <- tryCatch(expr = condition(IndexEvent),
             error = function(e) {
               tryCatch(expr = condition(IndexEvent),
                        warning = function (w) {
                          tryCatch(expr = procedure(IndexEvent),
                                   error = function(e) {
                                     tryCatch(expr = procedure(IndexEvent),
                                              warning= function(w) {
                                                tryCatch(expr = visit(IndexEvent),
                                                         error = function(e) {
                                                           tryCatch(expr = visit(IndexEvent),
                                                                    warning = function(w) {
                                                                      tryCatch(expr = drug(IndexEvent),
                                                                               error = function(e) {
                                                                                 tryCatch(expr = drug(IndexEvent),
                                                                                          warning = function(w) {
                                                                                            finally = print("No Index Event Found")
                                                                                          })
                                                                               })
                                                                    })
                                                         })
                                              })
                                   })
                        })
             })
  } else {
    IndexEventType = as.character(IndexEventType)
    
    validDomains <- c("conditionEra",
                      "condition",
                      "death",
                      "drug",
                      "drugEra",
                      "measurement",
                      "observation",
                      "visit")
    
    stopifnot(IndexEventType %in% validDomains)
    
    e <- match.fun(IndexEventType)(conceptSet = IndexEvent)
  }
  
  e1 <- entry(e)

}



## 测试数据

c1 <-new("ConceptSet", id = "fa773477eb0c08e1b8d6c7fca590ec21", Name = "QF - Inpatient or Inpatient/ER visit", 
    Expression = list(new("ConceptSetItem", Concept = new("Concept", 
                                                          concept_id = 262L, concept_name = "Emergency Room and Inpatient Visit", 
                                                          standard_concept = "S", standard_concept_caption = "Standard", 
                                                          invalid_reason = "V", invalid_reason_caption = "Valid", 
                                                          concept_code = "ERIP", domain_id = "Visit", vocabulary_id = "Visit", 
                                                          concept_class_id = "Visit"), isExcluded = FALSE, includeDescendants = TRUE, 
                          includeMapped = FALSE), new("ConceptSetItem", Concept = new("Concept", 
                                                                                      concept_id = 8717L, concept_name = "Inpatient Hospital", 
                                                                                      standard_concept = "S", standard_concept_caption = "Standard", 
                                                                                      invalid_reason = "V", invalid_reason_caption = "Valid", 
                                                                                      concept_code = "21", domain_id = "Visit", vocabulary_id = "CMS Place of Service", 
                                                                                      concept_class_id = "Visit"), isExcluded = FALSE, includeDescendants = TRUE, 
                                                      includeMapped = FALSE), new("ConceptSetItem", Concept = new("Concept", 
                                                                                                                  concept_id = 9201L, concept_name = "Inpatient Visit", 
                                                                                                                  standard_concept = "S", standard_concept_caption = "Standard", 
                                                                                                                  invalid_reason = "V", invalid_reason_caption = "Valid", 
                                                                                                                  concept_code = "IP", domain_id = "Visit", vocabulary_id = "Visit", 
                                                                                                                  concept_class_id = "Visit"), isExcluded = FALSE, includeDescendants = TRUE, 
                                                                                  includeMapped = FALSE)))

# c1 属于 visit 类型的 EventType

ce1 <- cohort_entry(IndexEvent = c1, IndexEventType = "visit")
ce1@entryEvents[[1]]@domain

ce2 <- cohort_entry(IndexEvent = c1) # 未指定 IndexEventType 时，程序选了错误的EventType，因为只检测了错误没检测警告
ce2@entryEvents[[1]]@domain 

# 可选的EventType包括以下这些
condition(c1)
drug(c1)
procedure(c1)

可以编写一个辅助函数，同时捕获执行表达式时的错误和警告，然后遍历所有有效EventType，找到第一个既无错误也无警告的执行结果。

改写后的函数 #

library(Capr)

# 辅助函数：同时捕获错误和警告，返回结果或状态
safe_exec <- function(expr) {
  result <- list(value = NULL, error = NULL, warning = NULL)
  withCallingHandlers(
    tryCatch({
      result$value <- expr
    }, error = function(e) {
      result$error <- e$message
    }),
    warning = function(w) {
      result$warning <- w$message
      invokeRestart("muffleWarning") # 抑制警告输出
    }
  )
  return(result)
}

cohort_entry <- function(IndexEventType = NA_character_, IndexEvent) {
  validDomains <- c("conditionEra", "condition", "death", "drug", 
                    "drugEra", "measurement", "observation", "visit")
  
  if (!is.na(IndexEventType)) {
    IndexEventType <- as.character(IndexEventType)
    stopifnot(IndexEventType %in% validDomains)
    e <- match.fun(IndexEventType)(conceptSet = IndexEvent)
  } else {
    # 遍历所有有效EventType，找到第一个无错无警告的
    e <- NULL
    for (domain in validDomains) {
      res <- safe_exec(match.fun(domain)(conceptSet = IndexEvent))
      if (is.null(res$error) && is.null(res$warning)) {
        e <- res$value
        break
      }
    }
    if (is.null(e)) {
      stop("No valid Index Event Type found")
    }
  }
  
  entry(e)
}

测试验证 #

运行测试代码：

# 指定EventType测试
ce1 <- cohort_entry(IndexEvent = c1, IndexEventType = "visit")
ce1@entryEvents[[1]]@domain # 应返回 "Visit"

# 自动检测EventType测试
ce2 <- cohort_entry(IndexEvent = c1)
ce2@entryEvents[[1]]@domain # 应正确返回 "Visit"

这个方案通过safe_exec函数同时捕获错误和警告，遍历所有有效EventType时直接判断是否符合"无错无警告"的条件，避免了原代码中嵌套tryCatch的混乱逻辑，同时保证了只会选择完全匹配的EventType。

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