在特定日期的线性模型中绘制残差
Plot residuals in linear model for specific date
编辑: 接受给出的第一个答案并制作一个函数以进一步使用它,但不使用 dplyr-package。不过,它很大程度上建立在给定的答案之上,所以谢谢。
plot_one_day <- function(LM,Day,DF) {Residuals<-resid(LM)
Filter=cbind(DF,Residuals)
Filterdata= Filter[Filter$Time>=paste(Day,"00:00:00") & Filter$Time<=paste(Day,"23:50:00"),]
Filter_NARM=Filterdata[!is.na(Filterdata$Residuals),]
plot(Residuals ~ Time, data=Filter_NARM, main=paste("Correlation for the",substr(Filter_NARM[1,1],1,10)),xlab="Time",
xlim=range(Filterdata$Time), ylim=range(Filter_NARM$Residuals))
abline(h=0, col="red")
}
plot_one_day(LM_1,"2015-05-07",MyData)
当你有这样的数据框时:
start <- as.POSIXct("2015-05-05 06:00:00", format="%Y-%m-%d %H:%M:%S")
end <- as.POSIXct("2015-05-07 20:00:00", format= "%Y-%m-%d %H:%M:%S")
Time=seq.POSIXt(start, end, by="10 min")
MyData=data.frame(Time=Time,Rain=rep(0,(length(Time))),Rain_Binary=rep(0,(length(Time))),People=rep(0,(length(Time))))
MyData[c(2:4,154:157,324:328),2]=5
MyData$People=round(runif(length(Time),0,50), digits=0)
for (Z in 1:nrow(MyData)) {Today= substr(MyData[Z,1], 1, 10)
if(any(MyData$Rain[((MyData$Time>= strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
(MyData$Time<= strptime(paste(Today, "09:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S")))]>0)) {MyData$Rain_Binary[(MyData$Time>=strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
(MyData$Time<= strptime(paste(Today, "20:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))]=1
}
}
MyData$Rain_Binary=as.factor(MyData$Rain_Binary)
并生成它的线性模型:
LM_1 = lm(People ~ Time + Rain_Binary, data=MyData, na.action = na.exclude)
你检查它的残差:
plot(resid(LM_1) ~ c(1:dim(MyData)[1]), data=MyData, main="Correlation complete",xlab="Time")
问题:如何在绘制残差的数据框中仅处理一天?这里报错:
plot(resid(LM_1) ~ MyData$Time[substr(MyData$Time,1,10)==strptime("2015-05-06",format="%Y-%m-%d")], data=MyData, main="Correlation 1 Day \n 2015-09-03", xlab="Time")
首先我无法在情节之前重现你的代码,它给出了一个错误:
start <- as.POSIXct("2015-05-05 06:00:00", format="%Y-%m-%d %H:%M:%S")
> end <- as.POSIXct("2015-05-07 20:00:00", format= "%Y-%m-%d %H:%M:%S")
> Time=seq.POSIXt(start, end, by="10 min")
>
> MyData=data.frame(Time=Time,Rain=rep(0,(length(Time))),Rain_Binary=rep(0,(length(Time))),People=rep(0,(length(Time))))
> MyData[c(2:4,154:157,324:328),2]=5
> MyData$People=round(runif(length(Time),0,50), digits=0)
> MyData$Rain_Binary=as.factor(MyData$Rain_Binary)
>
> for (Z in 1:nrow(MyData)) {Today= substr(MyData[Z,1], 1, 10)
+ if(any(MyData$Rain[((MyData$Time>= strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
+ (MyData$Time<= strptime(paste(Today, "09:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S")))]>0)) {MyData$Rain_Binary[(MyData$Time>=strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
+ (MyData$Time<= strptime(paste(Today, "20:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))]=1
+ }
+ }
There were 50 or more warnings (use warnings() to see the first 50)
>
> LM_1 = lm(People ~ Time + Rain_Binary, data=MyData, na.action = na.exclude)
Error in `contrasts<-`(`*tmp*`, value = contr.funs[1 + isOF[nn]]) :
contrasts can be applied only to factors with 2 or more levels
所以猜测你可能想要什么我修改代码:
start <- as.POSIXct("2015-05-05 06:00:00", format="%Y-%m-%d %H:%M:%S")
end <- as.POSIXct("2015-05-07 20:00:00", format= "%Y-%m-%d %H:%M:%S")
Time=seq.POSIXt(start, end, by="10 min")
MyData=data.frame(Time=Time,Rain=rep(0,(length(Time))),Rain_Binary=rep(0,(length(Time))),People=rep(0,(length(Time))))
MyData[c(2:4,154:157,324:328),2]=5
MyData$People=round(runif(length(Time),0,50), digits=0)
for (Z in 1:nrow(MyData)) {Today= substr(MyData[Z,1], 1, 10)
if(any(MyData$Rain[((MyData$Time>= strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
(MyData$Time<= strptime(paste(Today, "09:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S")))]>0)) {
MyData$Rain_Binary[(MyData$Time>=strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
(MyData$Time<= strptime(paste(Today, "20:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))]=1
}
}
MyData$Rain_Binary=as.factor(as.character(MyData$Rain_Binary))
最后我们绘制了一天的残差:“2015-05-06”
library(dplyr)
LM_1 = lm(People ~ Time + Rain_Binary, data=MyData)
MyData$Residuals<-resid(LM_1)
filteredData<-filter(MyData,Time>"2015-05-06 00:00"&Time<"2015-05-06 23:50")
plot(Residuals ~ Time, data=filteredData, main="Correlation 1 Day \n 2015-09-03",xlab="Time")
希望对您有所帮助
编辑: 接受给出的第一个答案并制作一个函数以进一步使用它,但不使用 dplyr-package。不过,它很大程度上建立在给定的答案之上,所以谢谢。
plot_one_day <- function(LM,Day,DF) {Residuals<-resid(LM)
Filter=cbind(DF,Residuals)
Filterdata= Filter[Filter$Time>=paste(Day,"00:00:00") & Filter$Time<=paste(Day,"23:50:00"),]
Filter_NARM=Filterdata[!is.na(Filterdata$Residuals),]
plot(Residuals ~ Time, data=Filter_NARM, main=paste("Correlation for the",substr(Filter_NARM[1,1],1,10)),xlab="Time",
xlim=range(Filterdata$Time), ylim=range(Filter_NARM$Residuals))
abline(h=0, col="red")
}
plot_one_day(LM_1,"2015-05-07",MyData)
当你有这样的数据框时:
start <- as.POSIXct("2015-05-05 06:00:00", format="%Y-%m-%d %H:%M:%S")
end <- as.POSIXct("2015-05-07 20:00:00", format= "%Y-%m-%d %H:%M:%S")
Time=seq.POSIXt(start, end, by="10 min")
MyData=data.frame(Time=Time,Rain=rep(0,(length(Time))),Rain_Binary=rep(0,(length(Time))),People=rep(0,(length(Time))))
MyData[c(2:4,154:157,324:328),2]=5
MyData$People=round(runif(length(Time),0,50), digits=0)
for (Z in 1:nrow(MyData)) {Today= substr(MyData[Z,1], 1, 10)
if(any(MyData$Rain[((MyData$Time>= strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
(MyData$Time<= strptime(paste(Today, "09:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S")))]>0)) {MyData$Rain_Binary[(MyData$Time>=strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
(MyData$Time<= strptime(paste(Today, "20:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))]=1
}
}
MyData$Rain_Binary=as.factor(MyData$Rain_Binary)
并生成它的线性模型:
LM_1 = lm(People ~ Time + Rain_Binary, data=MyData, na.action = na.exclude)
你检查它的残差:
plot(resid(LM_1) ~ c(1:dim(MyData)[1]), data=MyData, main="Correlation complete",xlab="Time")
问题:如何在绘制残差的数据框中仅处理一天?这里报错:
plot(resid(LM_1) ~ MyData$Time[substr(MyData$Time,1,10)==strptime("2015-05-06",format="%Y-%m-%d")], data=MyData, main="Correlation 1 Day \n 2015-09-03", xlab="Time")
首先我无法在情节之前重现你的代码,它给出了一个错误:
start <- as.POSIXct("2015-05-05 06:00:00", format="%Y-%m-%d %H:%M:%S")
> end <- as.POSIXct("2015-05-07 20:00:00", format= "%Y-%m-%d %H:%M:%S")
> Time=seq.POSIXt(start, end, by="10 min")
>
> MyData=data.frame(Time=Time,Rain=rep(0,(length(Time))),Rain_Binary=rep(0,(length(Time))),People=rep(0,(length(Time))))
> MyData[c(2:4,154:157,324:328),2]=5
> MyData$People=round(runif(length(Time),0,50), digits=0)
> MyData$Rain_Binary=as.factor(MyData$Rain_Binary)
>
> for (Z in 1:nrow(MyData)) {Today= substr(MyData[Z,1], 1, 10)
+ if(any(MyData$Rain[((MyData$Time>= strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
+ (MyData$Time<= strptime(paste(Today, "09:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S")))]>0)) {MyData$Rain_Binary[(MyData$Time>=strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
+ (MyData$Time<= strptime(paste(Today, "20:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))]=1
+ }
+ }
There were 50 or more warnings (use warnings() to see the first 50)
>
> LM_1 = lm(People ~ Time + Rain_Binary, data=MyData, na.action = na.exclude)
Error in `contrasts<-`(`*tmp*`, value = contr.funs[1 + isOF[nn]]) :
contrasts can be applied only to factors with 2 or more levels
所以猜测你可能想要什么我修改代码:
start <- as.POSIXct("2015-05-05 06:00:00", format="%Y-%m-%d %H:%M:%S")
end <- as.POSIXct("2015-05-07 20:00:00", format= "%Y-%m-%d %H:%M:%S")
Time=seq.POSIXt(start, end, by="10 min")
MyData=data.frame(Time=Time,Rain=rep(0,(length(Time))),Rain_Binary=rep(0,(length(Time))),People=rep(0,(length(Time))))
MyData[c(2:4,154:157,324:328),2]=5
MyData$People=round(runif(length(Time),0,50), digits=0)
for (Z in 1:nrow(MyData)) {Today= substr(MyData[Z,1], 1, 10)
if(any(MyData$Rain[((MyData$Time>= strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
(MyData$Time<= strptime(paste(Today, "09:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S")))]>0)) {
MyData$Rain_Binary[(MyData$Time>=strptime(paste(Today, "06:30:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))&
(MyData$Time<= strptime(paste(Today, "20:00:00", sep = " "),format="%Y-%m-%d %H:%M:%S"))]=1
}
}
MyData$Rain_Binary=as.factor(as.character(MyData$Rain_Binary))
最后我们绘制了一天的残差:“2015-05-06”
library(dplyr)
LM_1 = lm(People ~ Time + Rain_Binary, data=MyData)
MyData$Residuals<-resid(LM_1)
filteredData<-filter(MyData,Time>"2015-05-06 00:00"&Time<"2015-05-06 23:50")
plot(Residuals ~ Time, data=filteredData, main="Correlation 1 Day \n 2015-09-03",xlab="Time")
希望对您有所帮助