Я ищу более эффективный способ замены / поиска.
Мой текущий метод использует paste0 для создания значения поиска, а затем сопоставляет его с фильтром.
Учитывая x,
x <- data.frame(var1 = c("AA","BB","CC","DD"),
var2 = c("--","AA","AA","--"),
val1 = c(1,2,1,4),
val2 = c(5,5,7,8))
var1 var2 val1 val2
1 AA -- 1 5
2 BB AA 2 5
3 CC AA 1 7
4 DD -- 4 8
var1 - это основной столбец, а var2 - это дополнительный столбец. val1 и val2 являются столбцами значений.
Если var2 является значением в var1 и значения совпадают, мы хотим заменить указанный val на NA - и мы хотим сделать это независимо для столбцов значений.
В способе, который я придумал, используется поиск, который перебирает столбцы и по существу создает значение поиска.
lookup.df <- x %>% filter(var2 == "--")
x[,c("val1","val2")] <- lapply(c("val1","val2"), function(column) {
var2.lookup <- paste0(x$var2,x[[column]])
var1.lookup <- paste0(lookup.df$var1,lookup.df[[column]])
x[[column]][var2.lookup %in% var1.lookup] <- NA
return(x[[column]])
})
который возвращает то, что я ожидал.
> x
var1 var2 val1 val2
1 AA -- 1 5
2 BB AA 2 NA
3 CC AA NA 7
4 DD -- 4 8
Однако на практике при профилировании кода большая часть времени тратится на вставку - и это просто не самый эффективный способ сделать это.
Мой реальный набор данных - это миллионы строк и около 25 столбцов, и он работает примерно за 60 секунд. Я думаю, что был бы способ сделать замену логической матрицы вместо доступа к каждому столбцу индивидуально. Я не могу понять это все же.
Любая помощь очень ценится. Спасибо!
Редактировать - тесты
na.replace.orig <- function(x) {
lookup.df <- x %>% filter(var2 == "--")
x[,c("val1","val2")] <- lapply(c("val1","val2"), function(column) {
var2.lookup <- paste0(x$var2,x[[column]])
var1.lookup <- paste0(lookup.df$var1,lookup.df[[column]])
x[[column]][var2.lookup %in% var1.lookup] <- NA
return(x[[column]])
})
return(x)
}
# pulled out the lookup table since it causes a lot of overhead
na.replace.orig.no.lookup <- function(x) {
x[,c("val1","val2")] <- lapply(c("val1","val2"), function(column) {
var2.lookup <- paste0(x$var2,x[[column]])
var1.lookup <- paste0(lookup.df$var1,lookup.df[[column]])
x[[column]][var2.lookup %in% var1.lookup] <- NA
return(x[[column]])
})
return(x)
}
na.replace.1 <- function(x) {
inx <- match(x$var2, x$var1)
jnx <- which(!is.na(inx))
inx <- inx[!is.na(inx)]
knx <- grep("^val", names(x))
for(i in seq_along(inx))
for(k in knx)
if(x[[k]][inx[i]] == x[[k]][jnx[i]]) x[[k]][jnx[i]] <- NA
return(x)
}
na.replace.2 <- function(x) {
for(col in c("val1","val2")) {
x[x[,'var2'] %in% x[,'var1'] & x[,col] %in% lookup.df[,col] , col] <- NA
}
return(x)
}
> microbenchmark::microbenchmark(na.replace.orig(x), na.replace.orig.no.lookup(x), na.replace.1(x), na.replace.2(x), times = 10)
Unit: microseconds
expr min lq mean median uq max neval
na.replace.orig(x) 1267.23 1274.2 1441.9 1408.8 1609.8 1762.8 10
na.replace.orig.no.lookup(x) 217.43 228.9 270.9 239.2 296.6 394.2 10
na.replace.1(x) 98.46 106.3 133.0 123.9 136.6 239.2 10
na.replace.2(x) 117.74 147.7 162.9 166.6 183.0 189.9 10
Редактировать - требуется третья переменная
Я понял, что у меня есть третья переменная, с которой мне нужно проверить.
x <- data.frame(var1 = c("AA","BB","CC","DD"),
var2 = c("--","AA","AA","--"),
var3 = c("Y","Y","N","N"),
val1 = c(1,2,1,4),
val2 = c(5,5,7,8))
var1 var2 var3 val1 val2
1 AA -- Y 1 5
2 BB AA Y 2 5
3 CC AA N 1 7
4 DD -- N 4 8
с ожидаемым результатом
var1 var2 var3 val1 val2
1 AA -- Y 1 5
2 BB AA Y 2 NA
3 CC AA N 1 7
4 DD -- N 4 8
Мой код все еще работает для этого случая.
x[,c("val1","val2")] <- lapply(c("val1","val2"), function(column) {
var2.lookup <- paste0(x$var2, x$var3, x[[column]])
var1.lookup <- paste0(lookup.df$var1, x$var3, lookup.df[[column]])
x[[column]][var2.lookup %in% var1.lookup] <- NA
return(x[[column]])
})