作者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/m.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