Question

我有以下数据：

set.seed(26312)
id <- rep(c(1, 2, 3, 4, 5), each = 9)
wrc <- round(runif(36, 20, 100))
wrc <- c(wrc, wrc[10:18])
x <- rep(1:9, 5)
dat <- data.frame(id, wrc, x)

在此数据集中，id 2和id 5包含完全相同的数据但具有不同的ID。这可以通过运行来验证，

dat[dat$id == 2, ]
dat[dat$id == 5, ]

我有一个更大的数据集，有4321个ID，我想删除这些重复项，因为即使它们有不同的ID，它们实际上也是重复的。

目前，我正在组合一个非常糟糕且极其缓慢的for()和while()循环。在英语中，代码正在做的是对id进行子集化，然后将该id与我在while循环中子集化的每个其他id进行比较。当我发现重复，意味着所有数据行都相同时，它应该丢弃第一个重复的id。由此产生的cleaned_data是我想要的，到达那里是难以忍受的。因为当我有4321个ID时需要大约1分钟进行比较，所以运行这个糟糕的循环大约需要4321分钟。有人可以帮忙吗？

library("dplyr")
id_check = 1:5
cleaned_data <- data.frame()
for(i in id_check){
  compare_tmp <- dat %>% filter(id == i) 
  compare_check <- compare_tmp %>% select(wrc, x)
  duplicate = FALSE
  if(i == length(id_check)){
    cleaned_data <- rbind(cleaned_data, compare_tmp)
    break
  } else {
    id_tmp = i + 1
  }
  while(duplicate == FALSE){
    check <- dat %>% filter(id == id_tmp) %>% select(wrc, x)
    if(nrow(check) == 0) break
    duplicate = identical(compare_check, check)
    id_tmp = id_tmp + 1
    if(id_tmp == (length(id_check) + 1)) {
      break
    }
  }
  if(duplicate == FALSE){
    cleaned_data <- rbind(cleaned_data, compare_tmp)
  } 
}
cleaned_data

这是为了回复为什么重复不起作用。下面的ID 2和5不是相同的主题，因为数据并不总是相同的。

set.seed(26312)
id <- rep(c(1, 2, 3, 4, 5), each = 9)
wrc <- round(runif(36, 20, 100))
wrc <- c(wrc, wrc[c(1, 11:18)])
x <- rep(1:9, 5)
dat <- data.frame(id, wrc, x)
dat[dat$id == 2,]
dat[dat$id == 5,]

如果我运行dat[!duplicated(dat[2:3]),]，它会删除id 5，而不应该。

Answer 1

可能有以下几点：

do.call(
  rbind,
  split(dat, dat$id)[!duplicated(lapply(split(dat[2:3], dat$id), `rownames<-`, NULL), fromLast = TRUE)]
)

按id拆分，识别重复项，然后再次绑定非重复项。

修改
由于时间至关重要，我到目前为止已经对解决方案进行了基准测试：

set.seed(26312) p <- 4321 id <- rep(1:p, each = 9) dats <- replicate(p %/% 2, round(runif(9, 20, 100)), simplify = FALSE) wrc <- unlist(sample(dats, p, replace = TRUE)) x <- rep(1:9, times = p) dat <- data.frame(id, wrc, x) microbenchmark::microbenchmark( base = { do.call( rbind, split(dat, dat$id)[!duplicated(lapply(split(dat[2:3], dat$id), `rownames<-`, NULL), fromLast = TRUE)] ) }, tidyr = { as_tibble(dat) %>% nest(-id) %>% filter(!duplicated(data, fromLast = TRUE)) %>% unnest() }, reshape = { dat_wide = reshape2::dcast(dat, id ~ x, value.var = "wrc") dupes = dat_wide$id[duplicated(dat_wide[-1], fromLast = T)] no_dupes = dat[!dat$id %in% dupes, ] }, times = 10L ) # Unit: milliseconds # expr min lq mean median uq max neval cld # base 892.8239 980.36553 1090.87505 1096.12514 1187.98810 1232.47244 10 c # tidyr 944.8156 953.10558 977.71756 976.83703 990.58672 1033.27664 10 b # reshape 49.9955 50.13347 52.20539 51.91833 53.91568 55.64506 10 a

Answer 2

如果列结构准确，您可以转换为宽格式以进行重复检测：

dat_wide = reshape2::dcast(dat, id ~ x, value.var = "wrc")
dupes = dat_wide$id[duplicated(dat_wide[-1], fromLast = T)]

no_dupes = dat[!dat$id %in% dupes, ]

Answer 3

使用tidyr：

library(tidyr)
library(dplyr)

as_tibble(dat) %>% 
  nest(-id) %>%
  filter(!duplicated(data, fromLast = TRUE)) %>% 
  unnest()

# # A tibble: 36 x 3
#       id   wrc     x
#    <dbl> <dbl> <int>
#  1     1    53     1
#  2     1    44     2
#  3     1    70     3
#  4     1    31     4
#  5     1    67     5
#  6     1    50     6
#  7     1    70     7
#  8     1    40     8
#  9     1    52     9
# 10     3    95     1
# # ... with 26 more rows

（注意：不确定关于多个答案的Stackoverflow政策，但这个不同，足以得到一个单独的答案恕我直言（如果不是，请说出来，我将编辑我的初步答案）并删除这个。）

识别具有不同ID

3 个答案: