循环定制一个R函数来转换数据
问题描述：
我用这个代码创建事件的样本数据帧：循环定制一个R函数来转换数据
set.seed(100)
mydf <-data.frame(time=(1:100),
status = sample(c('OK','UNKNOWN'),1000,replace=TRUE),
event = sample(1:10,1000,replace=TRUE)
)
的数据是这样的：
head(mydf)
time status event
1 1 OK 1
2 2 OK 2
3 3 UNKNOWN 7
4 4 OK 7
5 5 OK 4
6 6 UNKNOWN 2
我想创建一个新的这样的数据集：
StartTime EndTime SeqID Sequence
1 1 3 1 {1,2,7}
2 4 6 2 {7,4,2}
基本上我想创建一个名为序列的列是事件数组， t我想在status列等于UNKNOWN之后重新开始。我已经尝试了一个while循环for循环，但没有成功。
答
标杆
这里有一个data.table解决方案：
library(data.table);
dt <- as.data.table(mydf);
dt[,.(StartTime=time[1L],EndTime=time[length(time)],Sequence=list(event)),.(SeqID=cumsum(status=='UNKNOWN')+1L)];
## SeqID StartTime EndTime Sequence
## 1: 1 1 2 1,2
## 2: 2 3 6 7,7,4,2
## 3: 3 7 8 1,5
## 4: 4 9 10 6,10
## 5: 5 11 11 4
## ---
## 513: 513 90 92 7,3,5
## 514: 514 93 93 2
## 515: 515 94 95 8,10
## 516: 516 96 99 3,2,3,1
## 517: 517 100 100 7
我相信你已经犯了一个错误与您期望的输出。如果序列从状态列等于UNKNOWN时开始，那么第一个数组应该是1,2而不是1,2,7。
更新：如果你想在序列行后的状态栏等于UNKNOWN中重新开始，那么你可以这样做：
dt[,.(StartTime=time[1L],EndTime=time[length(time)],Sequence=list(event)),.(SeqID=c(0L,cumsum(status[-length(status)]=='UNKNOWN'))+1L)];
## SeqID StartTime EndTime Sequence
## 1: 1 1 3 1,2,7
## 2: 2 4 7 7,4,2,1
## 3: 3 8 9 5,6
## 4: 4 10 11 10, 4
## 5: 5 12 12 2
## ---
## 512: 512 89 90 2,7
## 513: 513 91 93 3,5,2
## 514: 514 94 94 8
## 515: 515 95 96 10, 3
## 516: 516 97 100 2,3,1,7
请注意，您的预计产量仍然不正确;在此设计下，第二组应该是7,4,2,1而不是7,4,2。 编辑：其实，我想也许这个问题是在mydf有差异;我得到这个与样品创建代码：
head(mydf,10L);
## time status event
## 1 1 OK 1
## 2 2 OK 2
## 3 3 UNKNOWN 7
## 4 4 OK 7
## 5 5 OK 4
## 6 6 OK 2
## 7 7 UNKNOWN 1
## 8 8 OK 5
## 9 9 UNKNOWN 6
## 10 10 OK 10
请尝试用100.我们应该得到相同的结果为mydf种子再次运行样品创建代码。
这里的周围by()建一个基础R溶液：
with(list(SeqID=c(0L,cumsum(mydf$status[-nrow(mydf)]=='UNKNOWN'))+1L),
do.call(rbind,by(cbind(mydf,SeqID),SeqID,function(x)
data.frame(
SeqID=x$SeqID[1L],
StartTime=x$time[1L],
EndTime=x$time[length(x$time)],
Sequence=I(list(x$event))
)
))
);
## SeqID StartTime EndTime Sequence
## 1 1 1 3 1, 2, 7
## 2 2 4 7 7, 4, 2, 1
## 3 3 8 9 5, 6
## 4 4 10 11 10, 4
## 5 5 12 12 2
##
## ... snip ...
##
## 512 512 89 90 2, 7
## 513 513 91 93 3, 5, 2
## 514 514 94 94 8
## 515 515 95 96 10, 3
## 516 516 97 100 2, 3, 1, 7
标杆
library(data.table);
library(microbenchmark);
bgoldst1 <- function(dt) dt[,.(StartTime=time[1L],EndTime=time[length(time)],Sequence=list(event)),.(SeqID=c(0L,cumsum(status[-length(status)]=='UNKNOWN'))+1L)];
bgoldst2 <- function(mydf) with(list(SeqID=c(0L,cumsum(mydf$status[-nrow(mydf)]=='UNKNOWN'))+1L),do.call(rbind,by(cbind(mydf,SeqID),SeqID,function(x) data.frame(SeqID=x$SeqID[1L],StartTime=x$time[1L],EndTime=x$time[length(x$time)],Sequence=I(list(x$event))))));
lebatsnok <- function(mydf) { mydfs <- split(mydf, head(cumsum(c("", mydf$status) == "UNKNOWN"), -1)); res <- lapply(mydfs, function(x) data.frame(StartTime = x$time[1], EndTime = tail(x$time,1), SeqID = NA, Sequence = paste(x$event, collapse=","))); res <- do.call(rbind, res); res$SeqID <- seq_len(NROW(res)); res; };
set.seed(100L);
mydf <- data.frame(time=1:100,status=sample(c('OK','UNKNOWN'),1000L,T),event=sample(1:10,1000L,T),stringsAsFactors=F);
dt <- as.data.table(mydf);
ex <- as.data.frame(bgoldst1(dt)); o <- names(ex);
all.equal(ex,bgoldst2(mydf)[o],check.attributes=F);
## [1] TRUE
all.equal(transform(ex,Sequence=factor(sapply(Sequence,paste,collapse=','))),lebatsnok(mydf)[o],check.attributes=F);
## [1] TRUE
microbenchmark(bgoldst1(dt),bgoldst2(mydf),lebatsnok(mydf));
## Unit: milliseconds
## expr min lq mean median uq max neval
## bgoldst1(dt) 1.363785 1.671909 1.896345 1.839763 2.041828 3.900621 100
## bgoldst2(mydf) 217.960902 234.978058 244.491406 243.867674 251.392438 298.083774 100
## lebatsnok(mydf) 254.961413 273.434086 284.439844 283.864322 291.889867 337.319627 100
答
甲基R染料溶液（依赖于stringsAsFactors是FALSE，所以是myDF重新定义）：
set.seed(100)
mydf <-data.frame(time=(1:100),
status = sample(c('OK','UNKNOWN'),1000,replace=TRUE),
event = sample(1:10,1000,replace=TRUE), stringsAsFactors=FALSE
)
mydfs <- split(mydf, head(cumsum(c("", mydf$status) == "UNKNOWN"), -1))
res <- lapply(mydfs, function(x)
data.frame(StartTime = x$time[1],
EndTime = tail(x$time,1),
SeqID = NA,
Sequence = paste(x$event, collapse=",")))
res <- do.call(rbind, res)
res$SeqID <- seq_len(NROW(res))
head(res)
# StartTime EndTime SeqID Sequence
# 0 1 3 1 1,2,7
# 1 4 7 2 7,4,2,1
# 2 8 9 3 5,6
# 3 10 11 4 10,4
# 4 12 12 5 2
# 5 13 15 6 10,1,8
这个错误是在我的解释而不是示例。我希望数组中的最后一个值是状态为UNKNOWN的事件。 –