作者YangPeiHung (杨培宏)
看板R_Language
标题Re: [问题] 表格转换生成新标签与区间对照
时间Thu Apr 13 21:43:07 2017
後来我的长这样
sets<-function(start, end, group, overlap=length(unique(group))) {
dd<-rbind(data.frame(pos=start, event=1), data.frame(pos=end, event=-1))
dd<-aggregate(event~pos, dd, sum)
dd<-dd[order(dd$pos),]
dd$open <- cumsum(dd$event)
r<-rle(dd$open>=overlap)
ex<-cumsum(r$lengths-1 + rep(1, length(r$lengths)))
sx<-ex-r$lengths+1
cbind(dd$pos[sx[r$values]],dd$pos[ex[r$values]+1])
}
#维持原本我intersect的部分
library(foreach)
library(iterators)
library(data.table)
library(pipeR)
out= NULL
#准备给for loop吃
for(i in 1:10){
examTable1<-as.data.table(subset(examTable, examTable$examID == i)[,-2])
#把examID拿掉
with(examTable1, sets(Start, End, studentID,
length(unique(examTable1$studentID)))) ->intersect
colnames(intersect)<-c("Start", "End")
as.data.table(intersect)->intersect
setkey(intersect, Start, End)
finalDT <- foreach(it = isplit(examTable1, examTable1$studentID),
.final = rbindlist) %do%
{
foverlaps(it$value, intersect, type = "any", nomatch = 0) %>>%
`[`(j = average := average) %>>%
#这边因为已经平均过了所以不用再做一次除法，那是平均一秒内的分数
`[`(j = .(Start, End, studentID, average))
}
#开始不一样，我把你後面dcast跟填入colnames的地方改成下面这样
tmp <- as.data.frame.matrix(xtabs(average ~ Start + studentID, finalDT))
row.names(tmp)<-paste0(i,"_",intersect$Start,"_",intersect$End)
out=rbind(out,tmp)
}
如果从修改的地方换你的code 就会出现我上一篇推文说的错误
Error in inherits(object, "formula") ：传递了2个引数给'length'
但它需要1个
所以怎麽会传两个出去就是目前看不出来的地方，但是用xtabs就不会这样
--
※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 59.115.40.219
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/R_Language/M.1492090990.A.045.html
1F：→ celestialgod: 没看到你的finalDT，我也不知道有什麽资料重复还是 04/13 21:57
2F：→ celestialgod: 你的栏位跟我想的不一样造成的 04/13 21:58
3F：→ celestialgod: 不过你既然已经成功弄出来了，我想我也不需要再多 04/13 21:58
4F：→ celestialgod: 提供什麽协助就是 04/13 21:58