【问题标题】:Finding "outliers" in a group在组中查找“异常值”
【发布时间】:2015-05-17 02:39:48
【问题描述】:

我正在处理出院数据。具有相同 Patient_ID 的所有住院(病例)应该是同一个人。但是我发现有不同年龄和性别的 Pat_ID。

假设我有一个这样的数据集:

Case_ID <- 1:8
Pat_ID <- c(rep("1",4), rep("2",3),"3")
Sex <- c(rep(1,4), rep(2,2),1,1)
Age <- c(rep(33,3),76,rep(19,2),49,15)
Pat_File <- data.frame(Case_ID, Pat_ID, Sex,Age)

Case_ID Pat_ID Sex Age
1       1      1   33
2       1      1   33
3       1      1   33
4       1      1   76
5       2      2   19
6       2      2   19
7       2      1   49
8       3      1   15 

用彼此不同的案例识别 Pat_ID 相对容易。我通过在函数聚合的帮助下计算年龄和/或性别的平均值(编码为 1 和 2)找到这些 ID,然后计算平均值与年龄或性别之间的差异。我想自动删除/识别年龄或性别与大多数患者 ID 病例不同的病例。在我的示例中,我想删除案例 4 和 7。

【问题讨论】:

标签: r data-cleaning


【解决方案1】:

这是使用 sqldf 包的另一种方法: 1) 使用基于 Pat_ID、Sex 和 Age 的唯一组创建新数据框(称为 data_groups) 2)对于每个唯一组,检查 Pat_ID 与其他组,如果一个组的 Pat_ID 与另一组匹配,则选择计数较低的组并存储在新向量中(low_counts) 3) 取出新的数据名 (data_groups) 并从新向量 (low_counts) 中取出 Pat_IDs 4) 与 Pat_File 重组

代码如下:

library(sqldf)

# Create new dataframe with unique groups based on Pat_ID, Sex, and Age
data_groups <- sqldf("SELECT *, COUNT(*) FROM Pat_File GROUP BY Pat_ID, Sex, Age")
# Create New Vector to Store Pat_IDs with Sex and Age that differ from mode
low_counts <- vector()
# Unique groups
data_groups

for(i in 1:length(data_groups[,1])){
  for(j in 1:length(data_groups[,1])){
    if(i<j){
      k <- length(low_counts)+1
      result <- data_groups[i,2]==data_groups[j,2]
      if(is.na(result)){result <- FALSE}
      if(result==TRUE){
        if(data_groups[i,5]<data_groups[j,5]){low_counts[k] <- data_groups[i,1]}      
        else{low_counts[k] <- data_groups[j,1]}
      }
    }
  }
}

low_counts <- as.data.frame(low_counts)
# Take out lower counts
data_groups <- sqldf("SELECT * FROM data_groups WHERE Case_ID NOT IN (SELECT * FROM low_counts)")

Pat_File <- sqldf("SELECT Pat_File.Case_ID, Pat_File.Pat_ID, Pat_File.Sex, Pat_File.Age FROM data_groups, Pat_File WHERE data_groups.Pat_ID=Pat_File.Pat_ID AND data_groups.Sex=Pat_File.Sex AND data_groups.Age=Pat_File.Age ORDER BY Pat_File.Case_ID")

Pat_File

提供以下结果:

  Case_ID Pat_ID Sex Age
1       1      1   1  33
2       2      1   1  33
3       3      1   1  33
4       5      2   2  19
5       6      2   2  19
6       8      3   1  15

【讨论】:

    【解决方案2】:

    你可以试试

    library(data.table)
    

    使用 Mode 来自 Is there a built-in function for finding the mode?

      Mode <- function(x) {
        ux <- unique(x)
        ux[which.max(tabulate(match(x, ux)))]
     }
    
    setDT(Pat_File)[, .SD[Age==Mode(Age) & Sex==Mode(Sex)] , by=Pat_ID]
    #    Pat_ID Case_ID Sex Age
    #1:      1       1   1  33
    #2:      1       2   1  33
    #3:      1       3   1  33
    #4:      2       5   2  19
    #5:      2       6   2  19
    #6:      3       8   1  15
    

    测试其他情况,

     Pat_File$Sex[6] <- 1
     Pat_File$Age[4] <- 16
     setDT(Pat_File)[, .SD[Age==Mode(Age) & Sex==Mode(Sex)] , by=Pat_ID]
     #    Pat_ID Case_ID Sex Age
     #1:      1       1   1  33
     #2:      1       2   1  33
     #3:      1       3   1  33
     #4:      2       6   1  19
     #5:      3       8   1  15
    

    【讨论】:

    • 如果 Pat_ID 的年龄异常值是 16 而不是 76,那么这不起作用。
    • 使用mode 而不是mean 这现在适用于检查年龄的情况。 - 整洁的功能。
    • @jalapic 我认为它现在应该可以工作了。尝试更改Pat_File$Sex[6] &lt;- 1;Pat_File$Age[4] &lt;- 16;得到和你一样的结果
    • 我没有这个功能,这一切都可以通过as.numeric(names(sort(-table(x)))[1])来完成
    • @DavidArenburg 是的,这也行得通,我认为tabulate 可能会快一点,未经测试
    【解决方案3】:

    我相信这种方法有效,但我怀疑它是最快或最有效的方法。

    本质上,我通过您的分组变量拆分数据框。然后我找到了你关心的变量的“模式”。然后我们过滤了那些不包含所有模式的观察结果。然后我们将所有东西重新组合在一起:

    library(dplyr) # I used dplyr to 'filter' though you could do it another way
    temp <- split(Pat_File, Pat_ID)
    
    Mode.Sex <- lapply(temp, function(x) { temp1 <- table(as.vector(x$Sex)); names(temp1)[temp1 == max(temp1)]})
    
    Mode.Age <- lapply(temp, function(x) { temp1 <- table(as.vector(x$Age)); names(temp1)[temp1 == max(temp1)]})
    
    temp.f<-NULL
    for(i in 1:length(temp)){
      temp.f[[i]] <- temp[[i]] %>% filter(Sex==Mode.Sex[[i]] & Age==Mode.Age[[i]])
    }
    
    do.call("rbind", temp.f)
    
    #  Case_ID Pat_ID Sex Age
    #1       1      1   1  33
    #2       2      1   1  33
    #3       3      1   1  33
    #4       5      2   2  19
    #5       6      2   2  19
    #6       8      3   1  15
    

    【讨论】:

      猜你喜欢
      • 2012-05-17
      • 1970-01-01
      • 2021-10-23
      • 1970-01-01
      • 2015-03-13
      • 2021-07-19
      • 2013-02-16
      • 2021-12-05
      • 1970-01-01
      相关资源
      最近更新 更多