我是 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天。
[编辑]最新方法:此方法使用 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 包IRanges
和dplyr
的方法可以为约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
- 家庭功能来加速此协议的想法?
感谢您的时间!
答案 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
。此处可能不需要列bri
和gaps
。
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")