使用ddply或ply-family函数

时间:2015-11-19 06:01:52

标签: r postgresql plyr

我是 R 的高级初学者,非常感谢您对以下问题的看法。可以使用ddply包中的plyr函数或其他ply - 族函数来解决此问题的各个部分。但是,完整的解决方案仍然无法实现。

渴望建议:更快的 R - 或基于Postgre SQL的解决方案,解决了可在Mac上实施的以下问题。应避免使用服务器端解决方案。对下面摘录的代码进行定时表明,瓶颈是大数据帧和rbind步骤的采样 - 然后是for循环。

任务:找到停止服用特定药物太长时间的去识别医疗患者(,那些甚至有一种药物'缺口'的患者比某些药物更长统计推导的阈值)。 R dataframe Claims包含代表不同处方的行。取消标识的患者代码存储在Claims$id,处方开始日期Claims$sdate和处方结束日期Claims$edate

以下显示了 R 数据框Claims中的两个示例。日期在这里写成代表自2000年1月1日以来几天的整数:

  id    sdate    edate
  A     1        90
  A     14       15
  A     121      180
  B     1        30
  B     2000     2030
  ...   ...      ...      

所有间隙的统计分析表明,阈值间隙长度为60天。

  • 正确的程序只会将患者A移动到分析的下一步。这是因为患者A实际上只有两个处方,只有30天的间隙(从第91天到第120天) ,结束他重叠的第一/第二处方并开始他的第三个处方)。与此同时,患者B有1970年的差距。
  • 但错误的程序会消除患者A. 例如,他的第二和第三处方的成对比较会识别错误的太长的间隙(长度为75天,从第15天到第91天)点。

[编辑]最新方法:此方法使用 R 函数IRanges::IRanges()base::split处理300,000名患者的300万条记录。秒。

ClaimsByMember <- with(Claims, split(IRanges(as.numeric(Claims$startdate), as.numeric(Claims$enddate)), member_id))
Gaps <- as.data.frame((width(gaps(ClaimsByMember))))
Gaps <- select(Gaps, -group)
Gaps <- as.data.frame(Gaps)
colnames(Gaps) <- c("member_id", "daysgap")



OLDER APPROACH:这种基于 R IRangesdplyr的方法可以为约4,000名患者处理~2,000行~7在具有16 GB RAM的Mac Book Pro上由最新版本的R执行时,秒(约3,000行/秒)。但是对于300万行和600,000名患者(每秒100到1,600行),它会减慢到大约0.5到8小时的某个时间点;运行时存在不确定性,因为我没有使用system.time计算时间。

  library(IRanges)
  library(plyr)

  # Read in the raw dataset.
    Claims <- read.csv("claims.csv")

  > id    sdate    edate
  > A     1        90
  > A     14       15
  > A     121      180
  > B     1        30
  > B     2000     2030
  > ...   ...      ... 

  smart <- function(Claims)
  {
    # MemberClaims_I is an IRanges object that handles each sdate/edate 
    # row of prescription data in MemberClaims as a sequence of 
    # consecutive integers with some length ('width').
    # Each of these sequences is defined by the variables start and end.
    # width is automatically calculated
      MemberClaims_I <- IRanges(start = as.numeric(Claims$startdate), 
        end = as.numeric(Claims$enddate))

    # MemberClaims_Red is an IRanges object that stores the fully      
    # overlapped ('reduced') prescriptions of the current patient
    # as sequences of consecutive integers
      MemberClaims_Red <- reduce(MemberClaims_I)

    # MemberGaps is an IRanges object that stores the gaps      
    # between reduced prescription as sequences of consecutive integers
      MemberGaps <- as.data.frame(gaps(MemberClaims_Red))

  }

  member_id <- levels(Claims$member_id)
  Gaps <- ddply(Claims, .(member_id), smart)


  # Create a dataframe listing all patients.
  # Patients must be constructed before moving to the next steps of this analysis
  # Claims$id refers to patient ids
    Patients <- as.data.frame(levels(Claims$id))
    Patients

  > id    
  > A     
  > A     
  > A     
  > B     
  > B     
  > ...   
此时

Gaps可进行定义阈值间隙长度的分析,以排除间隙过长的患者。最后,将行添加到Patients以计算此药物的治疗时间。

关于如何使用ply - 家庭功能来加速此协议的想法?

感谢您的时间!

2 个答案:

答案 0 :(得分:1)

将处方的时间段作为范围序列处理我们可以使用集合的数学运算来为每个患者总结它们。我已经做了一些时间(完全是另一个任务)一些函数使用集合描述为一系列范围索引。

# this function tidies the definition of the set 
# making union of stacked and overlapping ranges
#
# dirty_bri  <- matrix(c(1,10,8,13,23,32,32,35,45,48,50,77,55,70,88,88), nrow = 2)
#
#      [,1] [,2] [,3] [,4] [,5] [,6] [,7]
# [1,]    1    8   23   32   45   50   88
# [2,]   10   13   32   35   48   77   88

tidy_bri <- function(bri) {
  false_ends <- sapply(bri[2,], function(x) any(x >= bri[1,]-1 & x < bri[2,]) )
  false_starts <- sapply(bri[1,], function(x) any(x > bri[1,] & x <= bri[2,]+1) )
  matrix(sort(c(bri[1,][!false_starts], bri[2,][!false_ends])), nrow = 2)
}

# tidy_bri(dirty_bri) -> my_bri
#
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    1   23   45   50   88
# [2,]   13   35   48   77   88

# calculates middle gaps in bri
midgaps_bri <- function(bri) {
  bri[1,] <- bri[1,] - 1
  bri[2,] <- bri[2,] + 1
  matrix(bri[-c(1, length(bri))], nrow =2)
}

# midgaps_bri(my_bri)
#
#      [,1] [,2] [,3] [,4]
# [1,]   14   36   49   78
# [2,]   22   44   49   87

现在我们可以使用这些功能并使用您的数据。

require("dplyr")

df <- read.table(text = "id    sdate    edate
  A     1        90
  A     14       15
  A     121      180
  B     1        30
  B     2000     2030", header = T)

df %>% group_by(id) %>% 
  summarise(bri = list(tidy_bri(matrix(c(sdate, edate), nrow = 2, byrow = T)))) -> df1

df1$gaps <- lapply(df1$bri, midgaps_bri) %>% lapply(function(mm) mm[2,] - mm[1,] + 1)
df1$maxgap <- unlist(lapply(df1$gaps, max))

df1 %>% View

    id  bri                     gaps    maxgap
1   A   c(1, 90, 121, 180)      30      30
2   B   c(1, 30, 2000, 2030)    1969    1969

现在,您可以使用必要的阈值过滤此data.frame。此处可能不需要列brigaps

df1 %>% select(-bri, -gaps) %>% filter(maxgap >= 60)

#       id maxgap
#   (fctr)  (dbl)
# 1      B   1969

答案 1 :(得分:0)

快速更新。我发现以下 R 脚本可以非常快速地完成任务:600,000名患者共计300万行,总计0.35秒。

  ClaimsByMember <- with(Claims, split(IRanges(as.numeric(Claims$startdate), as.numeric(Claims$enddate)), member_id))
  Gaps <- as.data.frame((width(gaps(ClaimsByMember))))
  Gaps <- select(Gaps, -group)
  Gaps <- as.data.frame(Gaps)
  colnames(Gaps) <- c("member_id", "daysgap")