_覓 | 覦覈襦 | 豕蠏手 | 殊螳 | 譯殊碁 |
FrontPage › 覲豌襴
|
|
[edit]
1 覲豌襴 #library(dplyr) df <- tbl_df(df) last_dt_df <- group_by(df, seq) %>% summarise(last_dt = last(std_dt)) last_dt_df <- filter(last_dt_df, last_dt == edt) df <- inner_join(df, last_dt_df, by="seq") df <- arrange(df, seq, std_dt) library("foreach") library(doParallel) cl<-makeCluster(3) registerDoParallel(cl) start.time <- Sys.time() #result <- foreach(i = unique(df$seq), .combine='rbind') %dopar%{ result <- foreach(i = 1:10000, .combine='rbind') %dopar%{ require(dplyr) tmp <- dplyr::filter(df, seq == i) %>% dplyr::mutate(x=row_number()) %>% dplyr::select(std_dt, seq, x) if(nrow(tmp) >= 3){ reference <- dplyr::filter(tmp, std_dt < edt) target <- dplyr::filter(tmp, std_dt == edt) require(MASS) model <- rlm(statvalue ~ x, data=reference) pred <- predict(model, target, interval="prediction", level=0.68) if(1==0){ plot(tmp$x, tmp$statvalue, ylim=c(pred[2]*1.1, max(tmp$statvalue))) line <- data.frame(predict(model, reference,interval = "prediction", level=0.68), reference) line <- line[order(line$x),] lines(line$x, line$fit, col="black", lty=2) lines(line$x, line$upr, col="blue", lty=2) lines(line$x, line$lwr, col="red", lty=2) add.error.bars(target$x, pred[1], pred[1]-pred[2], 0.1) points(target$x, target$statvalue, col="blue", pch=19) points(target$x, pred[1], col="red", pch=19) } if(target$statvalue > pred[3] & target$statvalue < pred[2]){ #print("蟆所") data.frame(dplyr::filter(tmp, std_dt == edt), fit=pred[1], lwr=pred[2], upr=pred[3]) } } #print(paste0(seq)) } stopCluster(cl) end.time <- Sys.time() time.taken <- end.time - start.time time.taken
鏤
|
蠖 蠍磯ゼ 滑 蠍磯 蠍壱襯 葛. |