В пределах идентификатора проверьте наличие совпадений / различий - PullRequest
9 голосов
/ 21 апреля 2011

У меня есть большой набор данных, более 1,5 миллионов строк, из 600 000 уникальных предметов, поэтому у нескольких предметов есть несколько рядов.Я пытаюсь найти случаи, когда у одного из испытуемых неправильно введен DOB.

test <- data.frame(
    ID=c(rep(1,3),rep(2,4),rep(3,2)),
    DOB = c(rep("2000-03-01",3), "2000-05-06", "2002-05-06",
     "2000-05-06", "2000-05-06", "2004-04-06", "2004-04-06")
)

> test
  ID        DOB
1  1 2000-03-01
2  1 2000-03-01
3  1 2000-03-01
4  2 2000-05-06
5  2 2002-05-06
6  2 2000-05-06
7  2 2000-05-06
8  3 2004-04-06
9  3 2004-04-06

Что мне нужно, так это какой-то код, по сути идентифицирующий, что в «2» есть ошибка.Я могу подумать о некоторых способах использования цикла for, но это было бы неэффективно в вычислительном отношении.

Спасибо

Ответы [ 4 ]

6 голосов
/ 21 апреля 2011

Используя базовые функции, самым быстрым решением будет что-то вроде:

> x <- unique(test[c("ID","DOB")])
> x$ID[duplicated(x$ID)]
[1] 2

Сроки:

n <- 1000
system.time(replicate(n,{
  x <- unique(test[c("ID","DOB")])
  x$ID[duplicated(x$ID)]
 }))
   user  system elapsed 
   0.70    0.00    0.71 

system.time(replicate(n,{
  DOBError(data)
}))
   user  system elapsed 
   1.69    0.00    1.69 

system.time(replicate(n,{
  zzz <- aggregate(DOB ~ ID, data = test, FUN = function(x) length(unique(x)))
  zzz[zzz$DOB > 1 ,]
}))
   user  system elapsed 
   4.23    0.02    4.27 

system.time(replicate(n,{
   zz <- ddply(test, "ID", summarise, dups = length(unique(DOB)))
   zz[zz$dups > 1 ,]
}))
   user  system elapsed 
   6.63    0.01    6.64 
5 голосов
/ 21 апреля 2011

Один подход с использованием plyr:

library(plyr)
  zz <- ddply(test, "ID", summarise, dups = length(unique(DOB)))
  zz[zz$dups > 1 ,]

А если база R - ваша вещь, используйте aggregate()

zzz <- aggregate(DOB ~ ID, data = test, FUN = function(x) length(unique(x)))
zzz[zzz$DOB > 1 ,]
3 голосов
/ 21 апреля 2011

При таком большом объеме я предлагаю другое решение, основанное на сравнении и использовании мощности векторных операций в R:

test <- test[order(test$ID), ]
n <- nrow(test)
ind <- test$ID[-1] == test$ID[-n] & test$DOB[-1] != test$DOB[-n]
unique(test$ID[c(FALSE,ind)])

Для test синхронизация данных аналогична Идея Йориса , но для больших данных:

test2 <- data.frame(
    ID = rep(1:600000,3),
    DOB = "2000-01-01",
    stringsAsFactors=FALSE
)
test2$DOB[sample.int(nrow(test2),5000)] <- "2000-01-02"

system.time(resA<-{
    x <- unique(test2[c("ID","DOB")])
    x$ID[duplicated(x$ID)]
})
#   user  system elapsed 
#   7.44    0.14    7.58 

system.time(resB <- {
    test2 <- test2[order(test2$ID), ]
    n <- nrow(test2)
    ind <- test2$ID[-1] == test2$ID[-n] & test2$DOB[-1] != test2$DOB[-n]
    unique(test2$ID[c(FALSE,ind)])
})
#   user  system elapsed 
#   0.76    0.04    0.81 

all.equal(sort(resA),sort(resB))
# [1] TRUE
2 голосов
/ 21 апреля 2011
DOBError <- function(data){

     count <- unlist(lapply(split(test, test$ID), 
        function(x)length(unique(x$DOB))))

     return(names(count)[count > 1])

}


DOBError(data)

[1] "2"
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...