R: удалить повторяющиеся строки с полным перекрытием не пропущенных переменных - PullRequest
3 голосов
/ 18 июня 2020

Во многих предыдущих вопросах освещаются различные способы удаления повторяющихся строк с пропущенными значениями, однако ни один из них не касается следующего случая. Пример исходных данных:

df <- data.frame(x = c(1, NA, 1), y=c(NA, 1, 1), z=c(0, NA, NA))
print(df)

Желаемый результат:

df2 <- data.frame(x = c(1, 1), y=c(NA, 1), z=c(0, NA))
print(df2)

В этом случае вторая строка была удалена, потому что это идеальное подмножество строки 3. В реальном приложении я хочу удалите строки, которые содержат всю избыточную информацию в не пропавших столбцах, и сохраните строку, в которой меньше всего отсутствует. . Я мог бы сделать это очень медленно для l oop, но с сотнями столбцов и тысячами строк это плохой вариант.

Ответы [ 2 ]

1 голос
/ 19 июня 2020

Вот еще один вариант с использованием data.table:

library(data.table)
#convert into long format and discard NAs
mDT <- melt(setDT(df)[, rn := .I], id.var="rn", na.rm=TRUE)[, cnt := .N , rn]

#self join and filter for rows that match to other rows
merged <- mDT[mDT, on=.(variable, value), {
      diffrow <- i.rn!=x.rn
      .(irn=i.rn[diffrow], xrn=x.rn[diffrow], icnt=i.cnt[diffrow])
    }]

#count the occurrence and delete rows where all values are matched to another row
ix <- merged[, xcnt := .N, .(irn, xrn)][
    icnt==xcnt]$irn

#delete dupe rows
df[-ix]
1 голос
/ 19 июня 2020

Не знаю, как это сделать с dplyr, но вот соултион с l oop. Также я не уверен, что решение dplyr может быть быстрее, чем l oop one (в конце оно должно использовать какое-то l oop), здесь вы можете хотя бы контролировать поток l oop.

Функция вектора подмножества определяет, является ли вектор a подмножеством вектора b (возврат 1) или вектор b является подмножеством вектора a (возвращает 2), в противном случае он возвращает 0. Затем I l oop по всем строкам data.frame и удаляет подмножество рядов.

subsetVector <- function(a, b){

  na_a <- which(is.na(a))
  na_b <- which(is.na(b))

  if(all(na_a %in% na_b)){
    if(all(a[-na_b] == b[-na_b])) return(2)
  }else if(all(na_b %in% na_a)){
    if(all(b[-na_a] == a[-na_a])) return(1)
  }

  return(0)
}

i <- 1
while(i < nrow(df)){

  remove_rows <- NULL

  for(j in (i+1):nrow(df)){

    p <- subsetVector(df[i,], df[j,])

    if(p == 1){
      remove_rows <- c(remove_rows, i)
      break()
    }else if(p == 2){
      remove_rows <- c(remove_rows, j)
    }
  }

  if(length(remove_rows) > 0)
    df <- df[-remove_rows,]

  if(!1 %in% remove_rows)
    i <- i + 1
}
...