Question

输入 dt-

dt <- data.frame(a_check=c(1,2,1,1,2),
                 b_check=c(0,1,NA,1,15),
                 c_check=c(1,0,0,1,NA),
                 d_check=c(1,1,1,0,0),
                 e_check=c(1,NA,0,1,1))

验证列表-

valid_values <- list(a_check= c(1,2,3), b_check= c(0,1),c_check=c(0,1,2),d_check="possitive integer",e_check="positive integer")
required_list <- list(a_check= 1, b_check= 1,c_check=0,d_check=1,e_check=0)
col_type_list <- list(a_check= "factor", b_check= "factor",c_check="continuous",d_check="continuous",e_check="continuous")

问题-

我试图通过使用以下多个ifelse条件来获得低于期望的输出-

如果variable中需要required_list，并且该列的dt包含NA，则其应提供的error（变量不能为NA，因为它是必需的）。
如果{{1}中的variable是continuous，则它应仅包含col_type_list中的正值，否则（变量必须是正整数）
如果{{1}中的dt是variable，则它应与factor列表中的值匹配，否则（变量必须是以下值之一）。

我可以使用col_type_list来获得结果，但是对于大数据集来说根本没有效率。

我的代码-

valid_value

输出-

nested for loops

注意-我知道可以使用@Jav的类似解决方案来实现

param_names <- colnames(dt)

error_msg <- list()
error <- list()

for(i in 1:nrow(dt)){

  for(j in 1:length(param_names))
  { 
    if(get(param_names[j],required_list) %in% 1 & is.na(as.numeric(unlist(dt[param_names[j]]))[i]) == TRUE)
    {

      error_msg[j] <- paste0(toupper(param_names[j]), " cannot be NA because it is required")

    }

    ## continuous variable check
    else if(get(param_names[j],col_type_list)=="continuous"){

      if (is.na(as.numeric(unlist(dt[param_names[j]]))[i]) | as.numeric(unlist(dt[param_names[j]]))[i] < 0) {
        error_msg[j] <- paste0(toupper(param_names[j]), " must be a positive integer")
      } else {

        error_msg[j] <- NA
      }


    } else {
      ## factor variable check

      if(!(as.numeric(unlist(dt[param_names[j]]))[i] %in% get(param_names[j],valid_values))){
        error_msg[j] <- paste0(toupper(param_names[j]), " must be one of the following values ", paste(get(param_names[j],valid_values), collapse = '-'))

      } else {

        error_msg[j] <- NA

      }
    }

  } ## end of inner for loop

  error[i] <- paste(unlist(error_msg),collapse = " & ")

}## end of inner f

final_error <- unlist(error)
setDT(dt)
dt[,error := final_error]
dt[,error := gsub("NA & | NA \\s+ &", "\\1", error)]
dt[,error := gsub("& \\s+ NA | & NA", "\\1", error)]

但是，我正在努力使用以上解决方案使用多个> dt a_check b_check c_check d_check e_check error 1: 1 0 1 1 1 NA 2: 2 1 0 1 NA E_CHECK must be a positive integer 3: 1 NA 0 1 0 B_CHECK cannot be NA 4: 1 1 1 0 1 NA 5: 2 15 NA 0 1 B_CHECK must be one of the following values 0-1 & C_CHECK must be a positive integer条件。我正在寻找一种高效清洁的解决方案来避免使用dt[, error := lapply(param_names, function(x) { ((get(x, dt) %in% get(x, valid_values))) %>% ifelse(., " ", paste(x, "should have valid values like -", paste(get(x, valid_values), collapse = " "))) }) %>% Reduce(paste, .)]。任何其他方法也可以。

Answer 1

您可以摆脱嵌套循环，但是仍然有很多代码需要编写。我认为最干净的方法是编写一个自定义函数来定义如何应用逻辑：

library(tidyverse)

check_col_validity <- function(col, name) {
  r_error <- rep(NA, length(col))

  # is required?
  if (required_list[name] == 1) {
    msg <- paste(toupper(name), "is required")
    r_error <- ifelse(is.na(col), msg, NA)
  }

  # is continuous?
  if (col_type_list[name] == "continuous") {
    msg <- paste(toupper(name), "must be positive")
    new_error <- ifelse(col < 0 | is.na(col), msg, NA)
    error <- ifelse(is.na(r_error), new_error, paste(r_error, new_error, sep = " & "))
  }

  # is in valid range?
  if (col_type_list[name] == "factor") {
    valid_range <- valid_values[[name]]
    msg <- paste(toupper(name), "must be one of", paste(valid_range, collapse = ", "))
    new_error <- ifelse(col %in% valid_range, NA, msg)
    error <- ifelse(is.na(r_error), new_error, r_error)
  }

  return(error)
}

这很像您的逻辑。区别在于如何将其应用于数据：

dt$error <- dt[, 1:5] %>%
  purrr::imap_dfc(check_col_validity) %>%
  t() %>%
  as_tibble() %>%
  purrr::map_chr(paste, collapse = " & ") %>%
  stringr::str_remove_all("NA & ") %>%
  stringr::str_remove_all(" & NA")

该功能使用purrr::imap应用于每一列。将结果转置并粘贴在一起，然后最后一步是删除难看的NA字符串。它提供了预期的结果，我希望代码更清晰。

此过程的主要部分是imap的工作方式。这是对列表的应用类型的操作，但是它将列表元素的名称作为第二个参数传递给函数。这意味着您可以编写应用于数据框每一列的自定义函数，并向该函数添加第二个参数，imap会将列名传递给该参数。一旦在函数中同时获得了列的数据和名称，该函数的编写就变得容易得多。

自定义函数返回适用于该列的错误消息。这意味着您将获得一个尺寸与原始数据集相同的数据框。然后，您可以转置此数据框并将每一列的结果粘贴在一起，从而每行获得1条消息。

一种基于嵌套的if条件创建新列并比较R中列表中的值的有效方法

1 个答案: