用ddply或ply-族函数的创造性使用替换R循环
我是R的高级初学者，非常感谢您对以下问题的思考。这个问题的一些部分可以通过使用来自ddply包的plyr函数或其他ply-family函数来解决。不过，我仍然没有找到一个完整的解决方案。
想要的建议：基于R-或Postgre的更快的解决方案，可以在Mac上实现以下问题。应避免服务器端解决方案。下面摘录的代码定时表明，瓶颈是一个大数据和一个rbind步骤的样本--然后这些步骤在一个for循环中。
任务：找出那些停止服用某一特定药物太久的患者(也就是那些甚至有一种药物“间隔”超过某些统计得出的阈值的患者)。R dataframe Claims有代表不同处方的行。未识别的病人代码存储在Claims$id中，处方开始日期存储在Claims$sdate中，处方结束日期存储在Claims$edate中.
下面显示了来自R dataframe Claims的两个示例。日期在这里以整数形式写成，表示自2000年1月1日以来的日子：
id sdate edate
A 1 90
A 14 15
A 121 180
B 1 30
B 2000 2030
... ... ... 对所有间隙的统计分析表明，阈值间隙长度为60d。
- A正确的程序将只将病人A移到分析的下一步。这是因为病人A实际上只有两张处方，间隔只有30天(从91天到120天，在结束了重叠的第一次/第二次处方和开始他的第三次处方之后)。病人B，同时，有一个1970年的间隔.
- 但是错误的程序会消除病人A，例如，对他的第二张和第三张处方进行配对比较会发现一个错误的太长的间隔( 75天，从第15天到第91天)。
编辑最新方法：这种方法使用R functions IRanges::IRanges()和base::split在0.3秒内处理60万名患者的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")旧方法:基于R包的IRanges和dplyr方法，当最新版本的R在16 GB内存的Mac上执行时，可在大约7秒钟(~3,000行/秒)内为4,000名患者处理大约20,000行。但是，对于300万行和60万名患者(每秒100至1600行；运行时存在不确定性，因为我没有使用system.time)，它会减慢到0.5到8h左右。
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-family函数加速该协议的思考？
谢谢您抽时间见我!
回答 2
Stack Overflow用户
发布于 2015-11-19 10:45:43
将处方周期作为范围的序列，我们可以用集合的数学运算来概括每个病人的处方周期。一段时间前，我已经完成了一些函数(完全用于另一项任务)，这些函数使用描述为范围索引序列的集合。
# 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 1969Stack Overflow用户
发布于 2015-11-21 07:10:14
快速更新。我发现下面的R脚本非常快地完成了任务:在0.35秒的时间内，为60万名患者提供了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")https://stackoverflow.com/questions/33796361
复制相似问题
腾讯云开发者
