Эффективный способ сравнения значений и создания нового столбца в R

Question

Я пытаюсь сравнить значения из каждой строки с действительными значениями (отдельный список), и, если значение строки не совпадает с действительными значениями, выдается сообщение об ошибке.

Я могу генерировать вывод, что я хочу. Но я чувствую, что это совсем не эффективный способ сделать это.

Моя попытка-

set.seed(1234)
dt <- data.frame(a_check=c(20,2,1,NA,0),
                 b_check=c(0,1,NA,1,15))    

valid_values <- list(a_check= c(1,2,3), b_check= c(0,1))
param_names <- colnames(dt)

error_msg <- list()
error <- list()
for(i in 1:nrow(dt)) {      
  for(j in 1:length(param_names)) {
    if(is.na(match(as.character(unlist(dt[param_names[j]]))[i], as.character(unlist(valid_values[j]))))) {
      error_msg[j] <- paste0(toupper(param_names[j]), " must be one of the following values ", paste(unlist(valid_values[j]), collapse = '-'))

    } else {
      error_msg[j] <- NA
    }
  }
  error[i] <- paste(unlist(error_msg), collapse = " & ")
}

final_error <- unlist(error)
dt$error <- final_error

Мой вывод:

> dt
  a_check b_check                                                                                               error
1      20       0                                              A_CHECK must be one of the following values 1-2-3 & NA
2       2       1                                                                                             NA & NA
3       1      NA                                                NA & B_CHECK must be one of the following values 0-1
4      NA       1                                              A_CHECK must be one of the following values 1-2-3 & NA
5       0      15 A_CHECK must be one of the following values 1-2-3 & B_CHECK must be one of the following values 0-1

Примечание- Я точно хочу, что я получаю, но я не хочу NA & NA, а также нет NA &. Это легко сделать для 2 переменных. Но у меня есть более 500 переменных.

Answer 1

добавьте проверочный столбец к вашей df и попробуйте функцию %in% ?match, возможно, с ifelse для TRUE|FALSE результатов ...

Мне нравится ответ @Jav,если вы добавите только изменение формы поверх (точнее, перед), вы можете получить всю информацию в виде двух столбцов, merge (т.е. объединить) ее с таблицей поиска ошибок, а затем преобразовать ее обратно в ширину

пример изменения формы:

dt_long <- reshape(data = dt,  times = names(dt),
               direction = 'long', timevar = "type", 
               varying = list(names(dt)), idvar = "id", v.names = "values")

Answer 2

Это тоже работает.Это немного более кратко / эффективно.Я могу проверить с microbenchmark позже, но похоже, что ваша проблема уже решена.

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

valid_values <- list(a_check= c(1,2,3), b_check= c(0,1))


dt_errors <- sapply(1:ncol(dt), function(x) ifelse(!dt[[x]] %in% valid_values[[x]],
                                                   paste0(toupper(names(dt)[x]), 
                                                          " must be one of the following values: ", 
                                                          paste(valid_values[[x]], collapse = ", ")), 
                                                   ""))

dt$error <- apply(dt_errors, 1 , paste, collapse = " & ")
dt$error <- trimws(gsub("^ &|& $", "", dt$error))
dt
  a_check b_check                                                                                                    error
1      20       0                                                     A_CHECK must be one of the following values: 1, 2, 3
2       2       1                                                                                                         
3       1      NA                                                        B_CHECK must be one of the following values: 0, 1
4      NA       1                                                     A_CHECK must be one of the following values: 1, 2, 3
5       0      15 A_CHECK must be one of the following values: 1, 2, 3 & B_CHECK must be one of the following values: 0, 1

РЕДАКТИРОВАТЬ: на самом деле, вам, возможно, придется скорректировать шаблон регулярных выражений, если существует более двух переменных, чтобы удалить лишние &.В противном случае, это должно хорошо масштабироваться.

Добавление еще одного оператора gsub должно помочь (теоретически).

dt$error <- apply(dt_errors, 1 , paste, collapse = " & ")    
dt$error <- gsub("( & )\\1+", "\\1", dt$error)
dt$error <- gsub("^ & | & $", "", dt$error)

Answer 3

Используя data.table, вы можете сделать это более векторизованным способом. Цикл по столбцам, но не по строкам:

> dt <- as.data.table(dt)

> dt[,  paste0(param_names, "_test") := lapply(param_names, function(x){
    get(x, dt) %in% get(x, valid_values)
})]


   a_check b_check a_check_test b_check_test
1:      20       0        FALSE         TRUE
2:       2       1         TRUE         TRUE
3:       1      NA         TRUE        FALSE
4:      NA       1        FALSE         TRUE
5:       0      15        FALSE        FALSE

РЕДАКТИРОВАТЬ: Назначение ответа для одного столбца:

library(magrittr)

dt[,  wrong_cols := lapply(param_names, function(x) {
    (!(get(x, dt) %in% get(x, valid_values))) %>%
      ifelse(., x, "")
  }) %>% Reduce(paste, .)]

> dt
   a_check b_check      wrong_cols
1:      20       0        a_check 
2:       2       1                
3:       1      NA         b_check
4:      NA       1        a_check 
5:       0      15 a_check b_check

EDIT_2

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

> dt
   a_check b_check                                                                                     error
1:      20       0                                            a_check should have valid values like - 1 2 3 
2:       2       1                                                                                          
3:       1      NA                                               b_check should have valid values like - 0 1
4:      NA       1                                            a_check should have valid values like - 1 2 3 
5:       0      15 a_check should have valid values like - 1 2 3 b_check should have valid values like - 0 1

Answer 4

library(purrr)
library(stringr)

compose_err_msg <- function(col)
  paste(toupper(col), 
        "must be one of the following values", 
        paste(valid_values[[col]], collapse = "-"))

dt$error <- 
  dt %>% 
  imap(~ ifelse(
    .x %in% valid_values[[.y]],
    list(character(0)),
    list(compose_err_msg(.y))
  )) %>% 
  transpose() %>% 
  map(lift(str_c, sep = " & ")) %>% 
  map_chr(~ if (identical(., character(0))) "" else .)

#   a_check b_check                                                                                               error
# 1      20       0                                                   A_CHECK must be one of the following values 1-2-3
# 2       2       1                                                                                                    
# 3       1      NA                                                     B_CHECK must be one of the following values 0-1
# 4      NA       1                                                   A_CHECK must be one of the following values 1-2-3
# 5       0      15 A_CHECK must be one of the following values 1-2-3 & B_CHECK must be one of the following values 0-1

Обратите внимание, что я не утверждаю, что это более эффективный или более простой способ сделать это.Здесь, очевидно, много чего происходит.

Ключ imap(), который перебирает столбцы (переменная .x) и их имена одновременно (.y).

Не столь важная часть использует stringr::str_c вместо paste, чтобы ответить на ограничение no "NA & NA".Это добавляет дополнительную сложность с необходимостью использовать character(0) и в конечном итоге заменить его на "".