按顺序应用规则以实现层次结构

时间:2016-04-23 22:38:57

标签: r loops

我尝试应用一系列规则并在条件满足时更改值。理想情况下,我希望避免循环,并拥有大量数据集(1250万观测值),因此效率会很好(但这只需要做一次,因此效率并不重要)。

示例数据如下所示。每个id都可以出现在多个date上,每个日期都可以有多个cc

set.seed(1)
id <- 1:200
date <- sample(seq(as.Date('2007/01/01'), as.Date('2012/12/31'), by="day"), 1000, replace=T)
cc <- sample(1:150, 1000, replace=T)
df <- data.frame(id, date, cc)
head(df)

id      date  cc
1 2011-04-28  69
2 2007-05-31 107
3 2012-08-02 100
4 2011-07-04  98
5 2010-08-20 147
6 2009-02-28  51

层次结构规则已经设置如下:

year <- rep(2007:2010, each=8)
ifcc <- c(5,7,8,9,15,16,17,18)
r1 <- c(112,NA,NA,NA,NA,NA)
r2 <- c(8,9,10,NA,NA,NA)
r3 <- c(9,10,NA,NA,NA,NA)
r4 <- c(10,NA,NA,NA,NA,NA)
r5 <- c(16,17,18,19,NA,NA)
r6 <- c(17,18,19,NA,NA,NA)
r7 <- c(18,19,NA,NA,NA,NA)
r8 <- c(19,NA,NA,NA,NA,NA)

h <- rbind(r1, r2, r3, r4, r5, r6, r7, r8)
h <- cbind(ifcc, h)
h <- data.frame(year, h)

head(h)
year ifcc  V2 V3 V4 V5 V6 V7
2007    5 112 NA NA NA NA NA
2007    7   8  9 10 NA NA NA
2007    8   9 10 NA NA NA NA
2007    9  10 NA NA NA NA NA
2007   15  16 17 18 19 NA NA
2007   16  17 18 19 NA NA NA

对于每个id / date组合,我需要检查层次结构表中的规则(对于那一年,因为它们每年都会更改)。如果cc中的条件类别dfifcc中的层次结构规则h匹配,那么h$V2 - h$V7中的任何值都是{对于id中的date / df组合,需要从h$V2删除与h$V7df匹配的行。

我很难绕过层次结构的查找和应用程序。有SAS代码,不仅一次一年,而且一系列手动输出if / then语句。有人给了它一个(http://healthydatascience.com/cms_hcc.html)但不是这个规模/多年以及如此多的重复措施......

我能够循环遍历并创建匹配的逻辑矩阵,但只需要30k的查找时间,但不可能扩展到12.5m。

t <- matrix(nrow=nrow(df), ncol=nrow(h))
for (j in 1:nrow(df)) {
  for (i in 1:nrow(h)){
  t[j,i] <- df[j,"cc"] == h[i,"ifcc"]
  }
}

我也无法弄清楚如何使用此矩阵作为应用层次结构规则的基础。

这个问题与此处的讨论直接相关: https://github.com/jackwasey/icd/issues/31 https://github.com/anobel/icdtohcc/issues/1

更新

我能够使用循环找到一个正常运行的解决方案。     h $ cc&lt; - h $ ifcc

# Merge hierarchy rules with patient data
df <- merge(df, h, all.x = TRUE)

###########
# create empty list
todrop <- list()

# create a list of dataframes that contain the CCs that will be zero'd out
for (i in 1:6) {
  todrop[[i]] <- df[!is.na(df$ifcc),c(1,2,3+i)]
}

# rename all dfs in list to same column names, rbind into one df
todrop <- lapply(1:length(todrop), function(x) {
  names(todrop[[x]]) <- c("id", "admtdate", "cc")
  return(todrop[[x]])
  }
)
todrop <- do.call(rbind, todrop)

# set flag, all of these CCs will be dropped
todrop$todrop <- T

# merge drop flags with pt data
df <- merge(df, todrop, all.x=T)
df <- df[is.na(pt$todrop), ]

1 个答案:

答案 0 :(得分:1)

使用data.table的替代解决方案:

正如您在问题中所要求的那样,代码非常有效。

.I是data.table提供的内置功能,它代表数据表的行号。

library(data.table)

## convert data.frame to data.table
setDT(df)

setDT(h)

## find year from date
df[,year := year(date)]

## merge the two datasets with all values of x present

## if order of tuples doesn't matter, please eliminate the sort=F argument
df2 <- merge(df,h[,.(year,ifcc,.I),],by.x = c('year','cc'),by.y = c('year','ifcc'),all.x = T,sort=F)

## obtaining df having NA values
df <- df2[is.na(I),.(id,date,cc)]

## converting back to data.frame (do it only if required)
setDF(df)