Блог

Ввод 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 условий, как показано ниже-

1. If variable требуется в required_list и dt содержит NA для этого столбца больше, чем его должно выдавать error (переменная не может быть NA, потому что она обязательна).
2. Если variable находится continuous в col_type_list , то оно должно содержать только положительные значения в dt else (переменная должна быть положительным целым числом)
3. Если variable находится factor в col_type_list , то оно должно соответствовать значению в valid_value списке else (переменная должна быть одним из следующих значений).

Я могу получить результат, используя nested for loops но это совсем не эффективно для большого набора данных.

Мой код-

 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 amp; 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 = " amp; ")

}## end of inner f

final_error <- unlist(error)
setDT(dt)
dt[,error := final_error]
dt[,error := gsub("NA amp; | NA \s  amp;", "\1", error)]
dt[,error := gsub("amp; \s  NA | amp; 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 amp; C_CHECK must be a positive integer
  

Примечание — я знаю, что это может быть достигнуто с помощью чего-то подобного решения от @Jav

 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, .)]
  

Но я изо всех сил пытаюсь использовать несколько ifelse условий, используя вышеупомянутое решение.
Я ищу эффективное и чистое решение, которого можно избежать for loops .
Любой другой метод также будет работать.

Вы можете избавиться от вложенных циклов, но все равно придется писать много кода. На мой взгляд, самый простой способ — написать пользовательскую функцию, которая определяет, как применяется логика:

 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 = " amp; "))
  }

  # 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 = " amp; ") %>%
  stringr::str_remove_all("NA amp; ") %>%
  stringr::str_remove_all(" amp; NA")
  

Функция применяется к каждому столбцу с помощью purrr::imap . Результат транспонируется и вставляется вместе, после чего последним шагом является удаление уродливых строк NA. Это обеспечивает ожидаемый результат, и я надеюсь, что код понятен для глаз.

Основная часть этого процесса заключается в том, как imap работает. Это операция типа apply над списком, но она передает имена элементов списка в качестве второго параметра функции. Это означает, что вы можете написать пользовательскую функцию, которая применяется к каждому столбцу фрейма данных, и добавить второй параметр к функции, которой imap будет передано имя столбца. Как только у вас есть данные и имя столбца, доступные внутри функции, функция становится намного проще в написании.

Пользовательская функция возвращает сообщения об ошибках, которые применяются к этому столбцу. Это означает, что вы получаете фрейм данных с теми же размерами, что и ваш исходный набор данных. Затем вы можете транспонировать этот фрейм данных и вставить результаты для каждого столбца вместе, чтобы получить 1 сообщение в строке.