#AADT_2060 <- 2.191  #US-41
#AADT_2060 <- 21.71660  #Projected AADT for SR 29 is 21716.60
#FWS_PVM2060 <- 2.1166 #5 year aa PVM predicted
AADT_2060 <- 37.72644  #Projected AADT for SR 29 is 21716.60
FWS_PVM2060 <- 2.8509 #5 year aa PVM predicted
#head(seg_df)
seg_df
ggplot(seg_df) +
geom_vline(aes(xintercept=1997), col="lightblue", lty=2, lwd=2) +  #just for SR29 fence
geom_vline(aes(xintercept=2007), col="lightblue", lty=2, lwd=2) +  #just for SR29 fence
geom_line(aes(x=YEAR, y=PVM), col="blue", lwd=0.5) +
geom_point(aes(x=YEAR, y=PVM), col="blue") +
geom_vline(aes(xintercept=2013.8), col="magenta") +
geom_vline(aes(xintercept=2019.2), col="magenta") +
ylab("PVM") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks) +
labs(title="PVM time series") +
geom_vline(aes(xintercept=2013.8), col="gray", lty=2) +
geom_vline(aes(xintercept=2019.2), col="gray", lty=2)
ggplot(seg_df) +
geom_line(aes(x=YEAR, y=PVM), col="blue", lwd=0.5) +
geom_point(aes(x=YEAR, y=PVM), col="blue") +
geom_vline(aes(xintercept=2013.8), col="magenta") +
geom_vline(aes(xintercept=2019.2), col="magenta") +
ylab("PVM") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks) +
labs(title="PVM time series") +
geom_vline(aes(xintercept=2013.8), col="gray", lty=2) +
geom_vline(aes(xintercept=2019.2), col="gray", lty=2)
ggplot(seg_df) +
geom_line(aes(x=YEAR, y=AADT), col="darkgreen", lwd=0.5) +
geom_point(aes(x=YEAR, y=AADT), col="darkgreen") +
geom_vline(aes(xintercept=2017), col="red") +
ylab("AADT") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks) +
labs(title="AADT time series")
ggplot(seg_df) +
geom_vline(aes(xintercept=1997), col="lightblue", lty=2, lwd=2) +  #just for SR29 fence
geom_vline(aes(xintercept=2007), col="lightblue", lty=2, lwd=2) +  #just for SR29 fence
geom_line(aes(x=YEAR, y=AADT_1000), col="darkgreen", lwd=0.5) +
geom_point(aes(x=YEAR, y=AADT_1000), col="darkgreen") +
geom_line(aes(x=YEAR, y=PVM), col="blue", lwd=0.5) +
geom_point(aes(x=YEAR, y=PVM), col="blue") +
ylab("AADT/1000 or PVM") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks) +
labs(title="Both PVM and AADT time series")
ggplot(seg_df, aes(x=AADT, y=PVM)) +
geom_point(col="blue") +
labs(title="AADT vs. yearly PVMs")
ggplot(seg_df, aes(x=ln_AADT, y=PVM)) +
geom_point(col="darkgreen") +
labs(title="log AADT vs. yearly PVMs")
ggplot(seg_df, aes(x=AADT, y=ln_PVM)) +
geom_point(col="magenta") +
labs(title="AADT vs. log yearly PVM")
ggplot(seg_df, aes(x=ln_AADT, y=ln_PVM)) +
geom_point(col="red") +
labs(title="log AADT vs. log yearly PVM")
glm_out <- glm(PVM ~ AADT_1000, family=poisson, data=seg_df)
summary(glm_out)
confint(glm_out)
newdata_df <- data.frame(YEAR=2060, AADT_1000=AADT_2060, PVM=NA) #ADD PROJECTED 2060 AADT
pred_2060_logmean <- predict(glm_out, newdata=newdata_df, type="link", se.fit=TRUE)
pred_2060_logmean$fit
pred_2060 <- exp(pred_2060_logmean$fit)
ci_logmean_2060 <- pred_2060_logmean$fit + c(-1,1)*2*pred_2060_logmean$se.fit
ci_mean_2060 <- exp(ci_logmean_2060)
pred_2060
ci_mean_2060
pred_uncert_reals <- replicate(10, mean(rpois(5,
lambda=exp(rnorm(1, mean=pred_2060_logmean$fit, sd=pred_2060_logmean$se.fit)))))
q_pois_pred_uncert <- quantile(pred_uncert_reals, probs=c(0.01, 0.05, 0.10, 0.25, 0.75, 0.90, 0.95, 0.99), na.rm=TRUE)
q_pois_pred_uncert
ggplot(seg_df) +
geom_line(aes(x=YEAR, y=AADT_1000), col="darkgreen", lwd=0.5) +
geom_point(aes(x=2017, y=AADT_1000[YEAR==2017]), col="magenta", size=3) +
geom_point(aes(x=YEAR, y=AADT_1000), col="darkgreen", size=2) +
geom_line(aes(x=YEAR, y=PVM), col="blue", lwd=0.5) +
geom_point(aes(x=YEAR, y=PVM), col="blue") +
geom_vline(aes(xintercept=2014.8), col="magenta", lty=2) +
geom_vline(aes(xintercept=2019.2), col="magenta", lty=2) +
ylab("PVM (blue) / AADT (green)") +
xlab("Year") +
xlim(c(1993, 2061)) +
geom_segment(aes(x=2017, xend=2060, y=AADT_1000[YEAR==2017], yend=AADT_2060), col="darkgreen", lty=2) +
geom_point(aes(x=2060, y=AADT_2060), col="magenta", size=3) +
geom_point(aes(x=2060, y=AADT_2060), col="darkgreen", size=2) +
geom_segment(aes(x=2014.8, xend=2019.2, y=mean(PVM[YEAR > 2014 & YEAR <= 2019]), yend=mean(PVM[YEAR > 2014 & YEAR <= 2019])), col="magenta", lty=2) +
geom_point(aes(x=2017, y=mean(PVM[YEAR > 2014 & YEAR <= 2019])), col="magenta", size=3) +
geom_point(aes(x=2017, y=mean(PVM[YEAR > 2014 & YEAR <= 2019])), col="blue", size=2) +
geom_segment(aes(x=2017, xend=2060, y=mean(PVM[YEAR > 2014 & YEAR <= 2019]), yend=((AADT_2060/AADT_1000[YEAR==2017])*mean(PVM[YEAR > 2014 & YEAR <= 2019]))), col="blue", lty=2) +
geom_point(aes(x=2060, y=((AADT_2060/AADT_1000[YEAR==2017])*mean(PVM[YEAR > 2014 & YEAR <= 2019]))), col="magenta", size=3) +
geom_point(aes(x=2060, y=((AADT_2060/AADT_1000[YEAR==2017])*mean(PVM[YEAR > 2014 & YEAR <= 2019]))), col="blue", size=2) +
geom_segment(aes(x=2060 + 1, xend=2060 + 1, y=q_pois_pred_uncert[6],
yend=q_pois_pred_uncert[3] ), col="yellow", lwd=3) +
geom_segment(aes(x=2060 + 1, xend=2060 + 1, y=q_pois_pred_uncert[7],
yend=q_pois_pred_uncert[2] ), col="orange", lwd=2) +
geom_segment(aes(x=2060 + 1, xend=2060 + 1, y=q_pois_pred_uncert[8],
yend=q_pois_pred_uncert[1] ), col="red", lwd=1) +
geom_point(aes(x=2060 + 1, y=pred_2060), col="red", size=3) +
scale_x_continuous(breaks=c(1997, 2001, 2005, 2009, 2013, 2017, 2021, 2030, 2040, 2050, 2060)) +
labs(caption="UPDATE prediction interval and PREDICTIONS")
((AADT_2060/AADT_1000[YEAR==2017])*mean(PVM[YEAR > 2014 & YEAR <= 2019]))
with(seg_lm,((AADT_2060/AADT_1000[YEAR==2017])*mean(PVM[YEAR > 2014 & YEAR <= 2019])))
with(seg_df,((AADT_2060/AADT_1000[YEAR==2017])*mean(PVM[YEAR > 2014 & YEAR <= 2019])))
with(seg_df,((AADT_2060/AADT_1000[YEAR==2017])))
with(seg_df,(AADT_1000[YEAR==2017]))
with(seg_df,(mean(PVM[YEAR > 2014 & YEAR <= 2019])))
with(seg_df,PVM[YEAR > 2014 & YEAR <= 2019])
ggplot(seg_df) +
geom_line(aes(x=YEAR, y=PVM), col="blue", lwd=0.5) +
geom_point(aes(x=YEAR, y=PVM), col="blue") +
geom_line(aes(x=YEAR, y=MA5_PVM), col="red", lwd=1) +
geom_point(aes(x=YEAR, y=MA5_PVM), col="red") +
ylab("PVM") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks)
seg_df_raw <- read_excel("ChurchRd_historicaldata.xlsx")
seg_df <- mutate(seg_df_raw,
PVM=as.numeric(PVM),
AADT=as.numeric(AADT),
AADT_1000=AADT/1000,
ln_AADT=log(AADT),
ln_AADT_1000=log(AADT_1000),
ln_PVM=log(PVM+0.1),
MA5_PVM=zoo::rollmean(PVM, k=5, fill=NA),
ln_MA5_PVM=log(MA5_PVM))
x_breaks <- seq(min(seg_df$YEAR), max(seg_df$YEAR), by=2)
x_labels <- as.character(x_breaks)
AADT_2060 <- 10.28744  #Projected AADT for Church Rd is 20287.44
FWS_PVM2060 <- 4.5722 #5 y
ggplot(seg_df) +
geom_line(aes(x=YEAR, y=PVM), col="blue", lwd=0.5) +
geom_point(aes(x=YEAR, y=PVM), col="blue") +
geom_vline(aes(xintercept=2013.8), col="magenta") +
geom_vline(aes(xintercept=2019.2), col="magenta") +
ylab("PVM") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks) +
labs(title="PVM time series") +
geom_vline(aes(xintercept=2013.8), col="gray", lty=2) +
geom_vline(aes(xintercept=2019.2), col="gray", lty=2)
ggplot(seg_df) +
geom_line(aes(x=YEAR, y=AADT), col="darkgreen", lwd=0.5) +
geom_point(aes(x=YEAR, y=AADT), col="darkgreen") +
geom_vline(aes(xintercept=2017), col="red") +
ylab("AADT") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks) +
labs(title="AADT time series")
ggplot(seg_df) +
geom_line(aes(x=YEAR, y=AADT_1000), col="darkgreen", lwd=0.5) +
geom_point(aes(x=YEAR, y=AADT_1000), col="darkgreen") +
geom_line(aes(x=YEAR, y=PVM), col="blue", lwd=0.5) +
geom_point(aes(x=YEAR, y=PVM), col="blue") +
ylab("AADT/1000 or PVM") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks) +
labs(title="Both PVM and AADT time series")
ggplot(seg_df, aes(x=AADT, y=PVM)) +
geom_point(col="blue") +
labs(title="AADT vs. yearly PVMs")
glm_out <- glm(PVM ~ AADT_1000, family=poisson, data=seg_df)
summary(glm_out)
confint(glm_out)
seg_df(AAADT_1000)
seg_df$AAADT_1000
seg_df$AADT_1000
red_fun <- function(t0, PVMdf) {
aa_PVM_t0 <- mean(PVMdf$PVM[PVMdf$YEAR %in% (t0-2):(t0+2)])
tot_PVM_t0 <- sum(PVMdf$PVM[PVMdf$YEAR %in% (t0-2):(t0+2)])
AADT_t0 <- PVMdf$AADT[PVMdf$YEAR == t0]
AADT_future_vec <- PVMdf$AADT[PVMdf$YEAR %in% (t0+5):(max(PVMdf$YEAR)-2)]
AADT_ratio_vec <- AADT_future_vec/AADT_t0
PVM_MA_years_vec <- PVMdf$YEAR[PVMdf$YEAR %in% (t0+3):max(PVMdf$YEAR)]
PVM_MA5obs_vec <- zoo::rollmean(PVMdf$PVM[PVMdf$YEAR %in% PVM_MA_years_vec], k=5)
PVM_pred_vec <- aa_PVM_t0*AADT_ratio_vec
PVM_pred_errs <- PVM_MA5obs_vec - PVM_pred_vec
PVM_pred_ratioerrs <- PVM_MA5obs_vec/PVM_pred_vec
years_vec <- PVMdf$YEAR[PVMdf$YEAR %in% (t0+5):(max(PVMdf$YEAR)-2)]
pred_df <- data.frame(PVM_MA5obs=PVM_MA5obs_vec, PVM_pred=PVM_pred_vec,
AADT_future=AADT_future_vec, AADT_ratio=AADT_ratio_vec,
PVM_pred_errs,
PVM_pred_ratioerrs, years=years_vec)
return(pred_df)
}
out_preds <- pred_fun(t0=1992, PVMdf=seg_df) #overpredicted in all years except first
out_preds <- pred_fun(t0=2011, PVMdf=seg_df) #overpredicted in all years except first
out_preds_2013 <- pred_fun(t0=1996, PVMdf=seg_df)
out_preds <- pred_fun(t0=2011, PVMdf=seg_df) #overpredicted in all years except first
out_preds_2013 <- pred_fun(t0=2013, PVMdf=seg_df)
## MAY NEED TO ADJUST t0 for different years!
## US41 - used 1996, 2000, 2005, 2007, 2010, 2012
out_preds <- pred_fun(t0=2011, PVMdf=seg_df) #overpredicted in all years except first
out_preds_2013 <- pred_fun(t0=2013, PVMdf=seg_df)
out_preds_2015 <- pred_fun(t0=2015, PVMdf=seg_df)
ggplot() +
geom_hline(yintercept=1.0, col="darkgray", lty=2) +
geom_line(data=out_preds, aes(x=years, y=AADT_ratio), col=1) +
geom_point(data=out_preds, aes(x=years, y=AADT_ratio), col=1)
help("filter")
seg_df_raw <- read_excel("SR29_SunnilandMine_historicaldata.xlsx")
seg_df <- mutate(seg_df_raw,
PVM=as.numeric(PVM),
AADT=as.numeric(AADT),
AADT_1000=AADT/1000,
ln_AADT=log(AADT),
ln_AADT_1000=log(AADT_1000),
ln_PVM=log(PVM+0.1),
MA5_PVM=zoo::rollmean(PVM, k=5, fill=NA),
ln_MA5_PVM=log(MA5_PVM))
seg_df <- dplyr::filter(seg_df, YEAR > 2006)
x_breaks <- seq(min(seg_df$YEAR), max(seg_df$YEAR), by=2)
x_labels <- as.character(x_breaks)
#AADT_2060 <- 2.191  #US-41
AADT_2060 <- 21.71660  #Projected AADT for SR 29 is 21716.60
FWS_PVM2060 <- 2.1166 #5 year aa PVM predicted
ggplot(seg_df) +
geom_vline(aes(xintercept=1997), col="lightblue", lty=2, lwd=2) +  #just for SR29 fence
geom_vline(aes(xintercept=2007), col="lightblue", lty=2, lwd=2) +  #just for SR29 fence
geom_line(aes(x=YEAR, y=PVM), col="blue", lwd=0.5) +
geom_point(aes(x=YEAR, y=PVM), col="blue") +
geom_vline(aes(xintercept=2013.8), col="magenta") +
geom_vline(aes(xintercept=2019.2), col="magenta") +
ylab("PVM") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks) +
labs(title="PVM time series") +
geom_vline(aes(xintercept=2013.8), col="gray", lty=2) +
geom_vline(aes(xintercept=2019.2), col="gray", lty=2)
ggplot(seg_df) +
# geom_vline(aes(xintercept=1997), col="lightblue", lty=2, lwd=2) +  #just for SR29 fence
#  geom_vline(aes(xintercept=2007), col="lightblue", lty=2, lwd=2) +  #just for SR29 fence
geom_line(aes(x=YEAR, y=PVM), col="blue", lwd=0.5) +
geom_point(aes(x=YEAR, y=PVM), col="blue") +
geom_vline(aes(xintercept=2013.8), col="magenta") +
geom_vline(aes(xintercept=2019.2), col="magenta") +
ylab("PVM") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks) +
labs(title="PVM time series") +
geom_vline(aes(xintercept=2013.8), col="gray", lty=2) +
geom_vline(aes(xintercept=2019.2), col="gray", lty=2)
ggplot(seg_df) +
geom_line(aes(x=YEAR, y=AADT), col="darkgreen", lwd=0.5) +
geom_point(aes(x=YEAR, y=AADT), col="darkgreen") +
geom_vline(aes(xintercept=2017), col="red") +
ylab("AADT") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks) +
labs(title="AADT time series")
ggplot(seg_df) +
#geom_vline(aes(xintercept=1997), col="lightblue", lty=2, lwd=2) +  #just for SR29 fence
#geom_vline(aes(xintercept=2007), col="lightblue", lty=2, lwd=2) +  #just for SR29 fence
geom_line(aes(x=YEAR, y=AADT_1000), col="darkgreen", lwd=0.5) +
geom_point(aes(x=YEAR, y=AADT_1000), col="darkgreen") +
geom_line(aes(x=YEAR, y=PVM), col="blue", lwd=0.5) +
geom_point(aes(x=YEAR, y=PVM), col="blue") +
ylab("AADT/1000 or PVM") +
xlab("Year") +
scale_x_continuous(breaks=x_breaks) +
labs(title="Both PVM and AADT time series")
ggplot(seg_df, aes(x=AADT, y=PVM)) +
geom_point(col="blue") +
labs(title="AADT vs. yearly PVMs")
ggplot(seg_df, aes(x=ln_AADT, y=PVM)) +
geom_point(col="darkgreen") +
labs(title="log AADT vs. yearly PVMs")
ggplot(seg_df, aes(x=AADT, y=ln_PVM)) +
geom_point(col="magenta") +
labs(title="AADT vs. log yearly PVM")
ggplot(seg_df, aes(x=ln_AADT, y=ln_PVM)) +
geom_point(col="red") +
labs(title="log AADT vs. log yearly PVM")
glm_out <- glm(PVM ~ AADT_1000, family=poisson, data=seg_df)
summary(glm_out)
confint(glm_out)
newdata_df <- data.frame(YEAR=2060, AADT_1000=AADT_2060, PVM=NA) #ADD PROJECTED 2060 AADT
pred_2060_logmean <- predict(glm_out, newdata=newdata_df, type="link", se.fit=TRUE)
pred_2060_logmean$fit
pred_2060 <- exp(pred_2060_logmean$fit)
ci_logmean_2060 <- pred_2060_logmean$fit + c(-1,1)*2*pred_2060_logmean$se.fit
ci_mean_2060 <- exp(ci_logmean_2060)
pred_2060
ci_mean_2060
pred_uncert_reals <- replicate(10, mean(rpois(5,
lambda=exp(rnorm(1, mean=pred_2060_logmean$fit, sd=pred_2060_logmean$se.fit)))))
q_pois_pred_uncert <- quantile(pred_uncert_reals, probs=c(0.01, 0.05, 0.10, 0.25, 0.75, 0.90, 0.95, 0.99), na.rm=TRUE)
q_pois_pred_uncert
ggplot(seg_df) +
geom_line(aes(x=YEAR, y=AADT_1000), col="darkgreen", lwd=0.5) +
geom_point(aes(x=2017, y=AADT_1000[YEAR==2017]), col="magenta", size=3) +
geom_point(aes(x=YEAR, y=AADT_1000), col="darkgreen", size=2) +
geom_line(aes(x=YEAR, y=PVM), col="blue", lwd=0.5) +
geom_point(aes(x=YEAR, y=PVM), col="blue") +
geom_vline(aes(xintercept=2014.8), col="magenta", lty=2) +
geom_vline(aes(xintercept=2019.2), col="magenta", lty=2) +
ylab("PVM (blue) / AADT (green)") +
xlab("Year") +
xlim(c(1993, 2061)) +
geom_segment(aes(x=2017, xend=2060, y=AADT_1000[YEAR==2017], yend=AADT_2060), col="darkgreen", lty=2) +
geom_point(aes(x=2060, y=AADT_2060), col="magenta", size=3) +
geom_point(aes(x=2060, y=AADT_2060), col="darkgreen", size=2) +
geom_segment(aes(x=2014.8, xend=2019.2, y=mean(PVM[YEAR > 2014 & YEAR <= 2019]), yend=mean(PVM[YEAR > 2014 & YEAR <= 2019])), col="magenta", lty=2) +
geom_point(aes(x=2017, y=mean(PVM[YEAR > 2014 & YEAR <= 2019])), col="magenta", size=3) +
geom_point(aes(x=2017, y=mean(PVM[YEAR > 2014 & YEAR <= 2019])), col="blue", size=2) +
geom_segment(aes(x=2017, xend=2060, y=mean(PVM[YEAR > 2014 & YEAR <= 2019]), yend=((AADT_2060/AADT_1000[YEAR==2017])*mean(PVM[YEAR > 2014 & YEAR <= 2019]))), col="blue", lty=2) +
geom_point(aes(x=2060, y=((AADT_2060/AADT_1000[YEAR==2017])*mean(PVM[YEAR > 2014 & YEAR <= 2019]))), col="magenta", size=3) +
geom_point(aes(x=2060, y=((AADT_2060/AADT_1000[YEAR==2017])*mean(PVM[YEAR > 2014 & YEAR <= 2019]))), col="blue", size=2) +
geom_segment(aes(x=2060 + 1, xend=2060 + 1, y=q_pois_pred_uncert[6],
yend=q_pois_pred_uncert[3] ), col="yellow", lwd=3) +
geom_segment(aes(x=2060 + 1, xend=2060 + 1, y=q_pois_pred_uncert[7],
yend=q_pois_pred_uncert[2] ), col="orange", lwd=2) +
geom_segment(aes(x=2060 + 1, xend=2060 + 1, y=q_pois_pred_uncert[8],
yend=q_pois_pred_uncert[1] ), col="red", lwd=1) +
geom_point(aes(x=2060 + 1, y=pred_2060), col="red", size=3) +
scale_x_continuous(breaks=c(1997, 2001, 2005, 2009, 2013, 2017, 2021, 2030, 2040, 2050, 2060))
pred_2060
pred_2060_logmean$fit
coef(glm_out)[2]
ggplot()+
geom_abline(slope=coef(glm_out)[2], intercept=coef(glm_out)[1])
ggplot()+
geom_point(seg_df, aes(x=AADT_1000, y=PVM), col="blue") +
geom_abline(slope=coef(glm_out)[2], intercept=coef(glm_out)[1], lty=1, col=1)
ggplot() +
geom_point(data=seg_df, aes(x=AADT_1000, y=PVM), col="blue") +
geom_abline(slope=coef(glm_out)[2], intercept=coef(glm_out)[1], lty=1, col=1)
gplot() +
geom_point(data=seg_df, aes(x=AADT_1000, y=ln_PVM), col="blue") +
geom_abline(slope=coef(glm_out)[2], intercept=coef(glm_out)[1], lty=1, col=1)
ggplot() +
geom_point(data=seg_df, aes(x=AADT_1000, y=ln_PVM), col="blue") +
geom_abline(slope=coef(glm_out)[2], intercept=coef(glm_out)[1], lty=1, col=1)
## MAY NEED TO ADJUST t0 for different years!
## US41 - used 1996, 2000, 2005, 2007, 2010, 2012
out_preds_2009 <- pred_fun(t0=2009, PVMdf=seg_df) #overpredicted in all years except first
seg_df_raw <- read_excel("SR29_SunnilandMine_historicaldata.xlsx")
seg_df <- mutate(seg_df_raw,
PVM=as.numeric(PVM),
AADT=as.numeric(AADT),
AADT_1000=AADT/1000,
ln_AADT=log(AADT),
ln_AADT_1000=log(AADT_1000),
ln_PVM=log(PVM+0.1),
MA5_PVM=zoo::rollmean(PVM, k=5, fill=NA),
ln_MA5_PVM=log(MA5_PVM + 0.1))
seg_df <- dplyr::filter(seg_df, YEAR > 2006) ## SUBSETTING TO 2007 and beyond
x_breaks <- seq(min(seg_df$YEAR), max(seg_df$YEAR), by=2)
x_labels <- as.character(x_breaks)
#AADT_2060 <- 2.191  #US-41
AADT_2060 <- 21.71660  #Projected AADT for SR 29 is 21716.60
FWS_PVM2060 <- 2.1166
seg_df
pred_fun <- function(t0, PVMdf) {
aa_PVM_t0 <- mean(PVMdf$PVM[PVMdf$YEAR %in% (t0-2):(t0+2)])
tot_PVM_t0 <- sum(PVMdf$PVM[PVMdf$YEAR %in% (t0-2):(t0+2)])
AADT_t0 <- PVMdf$AADT[PVMdf$YEAR == t0]
AADT_future_vec <- PVMdf$AADT[PVMdf$YEAR %in% (t0+5):(max(PVMdf$YEAR)-2)]
AADT_ratio_vec <- AADT_future_vec/AADT_t0
PVM_MA_years_vec <- PVMdf$YEAR[PVMdf$YEAR %in% (t0+3):max(PVMdf$YEAR)]
PVM_MA5obs_vec <- zoo::rollmean(PVMdf$PVM[PVMdf$YEAR %in% PVM_MA_years_vec], k=5)
PVM_pred_vec <- aa_PVM_t0*AADT_ratio_vec
PVM_pred_errs <- PVM_MA5obs_vec - PVM_pred_vec
PVM_pred_ratioerrs <- PVM_MA5obs_vec/PVM_pred_vec
years_vec <- PVMdf$YEAR[PVMdf$YEAR %in% (t0+5):(max(PVMdf$YEAR)-2)]
pred_df <- data.frame(PVM_MA5obs=PVM_MA5obs_vec, PVM_pred=PVM_pred_vec,
AADT_future=AADT_future_vec, AADT_ratio=AADT_ratio_vec,
PVM_pred_errs,
PVM_pred_ratioerrs, years=years_vec)
return(pred_df)
}
## MAY NEED TO ADJUST t0 for different years!
## US41 - used 1996, 2000, 2005, 2007, 2010, 2012
out_preds_2009 <- pred_fun(t0=2009, PVMdf=seg_df) #overpredicted in all years except first
out_preds_2010 <- pred_fun(t0=2010, PVMdf=seg_df)
out_preds_2011 <- pred_fun(t0=2011, PVMdf=seg_df)
out_preds_2012 <- pred_fun(t0=2012, PVMdf=seg_df)
out_preds_2013 <- pred_fun(t0=2013, PVMdf=seg_df)
pred2060_fun <- function(t0, PVMdf, AADT_2060) { #t0 is the baseline year for AADT
AADT_ratio_vec <- AADT_2060/AADT
PVM_pred_vec <- aa_PVM*AADT_ratio_vec
pred_df <- data.frame(aaPVM=aa_PVM, aaPVM_pred=PVM_pred_vec,
AADT_2060=AADT_2060, AADT_ratio=AADT_ratio_vec,
years=years_vec)
return(pred_df)
}
pred2060_fun <- function(PVMdf, AADT_2060) { #t0 is the baseline year for AADT
AADT_ratio_vec <- AADT_2060/PVMdf$AADT
PVM_pred_vec <- PVMdf$aa_PVM*AADT_ratio_vec
pred_df <- data.frame(aaPVM=aa_PVM, aaPVM_pred=PVM_pred_vec,
AADT_2060=AADT_2060, AADT_ratio=AADT_ratio_vec,
years=years_vec)
return(pred_df)
}
## MAY NEED TO ADJUST t0 for different years!
## US41 - used 1996, 2000, 2005, 2007, 2010, 2012
out_preds2060 <- pred2060_fun(AADT_2060=AADT_2060, PVMdf=seg_df) #overpredicted in all years except first
pred2060_fun <- function(PVMdf, AADT_2060) { #t0 is the baseline year for AADT
AADT_ratio_vec <- AADT_2060/PVMdf$AADT
PVM_pred_vec <- PVMdf$MA5_PVM*AADT_ratio_vec
pred_df <- data.frame(MA5_PVM=PVMdf$aa_PVM, PVM_pred=PVM_pred_vec,
AADT_2060=AADT_2060, AADT_ratio=AADT_ratio_vec,
years=MA5_PVM$YEAR)
return(pred_df)
}
## MAY NEED TO ADJUST t0 for different years!
## US41 - used 1996, 2000, 2005, 2007, 2010, 2012
out_preds2060 <- pred2060_fun(AADT_2060=AADT_2060, PVMdf=seg_df) #overpredicted in all years except first
pred2060_fun <- function(PVMdf, AADT_2060) { #t0 is the baseline year for AADT
AADT_ratio_vec <- AADT_2060/PVMdf$AADT
PVM_pred_vec <- PVMdf$MA5_PVM*AADT_ratio_vec
pred_df <- data.frame(MA5_PVM=PVMdf$MA5_PVM, PVM_pred=PVM_pred_vec,
AADT_2060=AADT_2060, AADT_ratio=AADT_ratio_vec,
years=MA5_PVM$YEAR)
return(pred_df)
}
## MAY NEED TO ADJUST t0 for different years!
## US41 - used 1996, 2000, 2005, 2007, 2010, 2012
out_preds2060 <- pred2060_fun(AADT_2060=AADT_2060, PVMdf=seg_df) #overpredicted in all years except first
## MAY NEED TO ADJUST t0 for different years!
## US41 - used 1996, 2000, 2005, 2007, 2010, 2012
out_preds2060 <- (AADT_2060/PVMdf$AADT)*seg_df$MA5_PVM #overpredicted in all years except first
## MAY NEED TO ADJUST t0 for different years!
## US41 - used 1996, 2000, 2005, 2007, 2010, 2012
out_preds2060 <- (AADT_2060/seg_df$AADT)*seg_df$MA5_PVM #overpredicted in all years except first
out_preds2060
AADT_2060
## MAY NEED TO ADJUST t0 for different years!
## US41 - used 1996, 2000, 2005, 2007, 2010, 2012
out_preds2060 <- ((AADT_2060*1000)/seg_df$AADT)*seg_df$MA5_PVM #overpredicted in all years except first
out_preds2060
seg_df_raw <- read_excel("SR29_SunnilandMine_historicaldata.xlsx")
AADT_2060 <- 21.71660  #Projected AADT for SR 29 is 21716.60
FWS_PVM2060 <- 2.1166 #5 year aa PVM predicted
seg_df <- mutate(seg_df_raw,
PVM=as.numeric(PVM),
AADT=as.numeric(AADT),
AADT_1000=AADT/1000,
ln_AADT=log(AADT),
ln_AADT_1000=log(AADT_1000),
ln_PVM=log(PVM+0.1),
MA5_PVM=zoo::rollmean(PVM, k=5, fill=NA),
ln_MA5_PVM=log(MA5_PVM + 0.1),
all_preds2060 <- (AADT_2060/AADT_1000)*MA5_PVM)
seg_df <- dplyr::filter(seg_df, YEAR > 2006) ## SUBSETTING TO 2007 and beyond
x_breaks <- seq(min(seg_df$YEAR), max(seg_df$YEAR), by=2)
x_labels <- as.character(x_breaks)
ggplot() +
geom_hline(yintercept=0, col="darkgray", lty=2) +
geom_line(data=seg_df, aes(x=YEAR, y=all_preds2060), col=1) +
geom_point(data=seg_df, aes(x=YEAR, y=all_preds2060), col=1, size=1.5) +
geom_point(data=seg_df, aes(x=2017, y=all_preds2060[YEAR==2017]), col="magenta", size=1.2) +
scale_x_continuous(breaks=x_breaks) +
xlab("Baseline year") +
ylab("2060 Predicted 5 yr avg. PVM") +
labs(title="2060 Predicted 5 yr avg PVM for different baselines",
caption="Just look at 2060 predictions based on different starting years")
names(seg_df)
seg_df_raw <- read_excel("SR29_SunnilandMine_historicaldata.xlsx")
AADT_2060 <- 21.71660  #Projected AADT for SR 29 is 21716.60
FWS_PVM2060 <- 2.1166 #5 year aa PVM predicted
seg_df <- mutate(seg_df_raw,
PVM=as.numeric(PVM),
AADT=as.numeric(AADT),
AADT_1000=AADT/1000,
ln_AADT=log(AADT),
ln_AADT_1000=log(AADT_1000),
ln_PVM=log(PVM+0.1),
MA5_PVM=zoo::rollmean(PVM, k=5, fill=NA),
ln_MA5_PVM=log(MA5_PVM + 0.1),
all_preds2060=(AADT_2060/AADT_1000)*MA5_PVM)
seg_df <- dplyr::filter(seg_df, YEAR > 2006) ## SUBSETTING TO 2007 and beyond
x_breaks <- seq(min(seg_df$YEAR), max(seg_df$YEAR), by=2)
x_labels <- as.character(x_breaks)
ggplot() +
geom_hline(yintercept=0, col="darkgray", lty=2) +
geom_line(data=seg_df, aes(x=YEAR, y=all_preds2060), col=1) +
geom_point(data=seg_df, aes(x=YEAR, y=all_preds2060), col=1, size=1.5) +
geom_point(data=seg_df, aes(x=2017, y=all_preds2060[YEAR==2017]), col="magenta", size=1.2) +
scale_x_continuous(breaks=x_breaks) +
xlab("Baseline year") +
ylab("2060 Predicted 5 yr avg. PVM") +
labs(title="2060 Predicted 5 yr avg PVM for different baselines",
caption="Just look at 2060 predictions based on different starting years")
replicate(100, mean(rpois(5, lambda=input$1.2))
replicate(100, mean(rpois(5, lambda=1.2))
)
rep(1:3, 2)
shiny::runApp('Documents/Documents/Current Clients/WildernessCharacterMonitoring/GatesOfTheArctic/Rwork/PVM_FWSprediction_uncertainty')
runApp('Documents/Documents/Current Clients/WildernessCharacterMonitoring/GatesOfTheArctic/Rwork/PVM_FWSprediction_uncertainty')
plot(1:10, 1:10)
runApp('Documents/Documents/Current Clients/WildernessCharacterMonitoring/GatesOfTheArctic/Rwork/PVM_FWSprediction_uncertainty')
help(curve)
runApp('Documents/Documents/Current Clients/WildernessCharacterMonitoring/GatesOfTheArctic/Rwork/PVM_FWSprediction_uncertainty')
1/5
2/5
runApp('Documents/Documents/Current Clients/WildernessCharacterMonitoring/GatesOfTheArctic/Rwork/PVM_FWSprediction_uncertainty')
help("hist")
help("hist")
runApp('Documents/Documents/Current Clients/WildernessCharacterMonitoring/GatesOfTheArctic/Rwork/PVM_FWSprediction_uncertainty')
test <- replicate(100, mean(rpois(5, lambda=0.5)))
test_tab <- table(test/100)
test_tab
test_tab2 <- table(test)/100
test_tab2
help("barplot")
runApp('Documents/Documents/Current Clients/WildernessCharacterMonitoring/GatesOfTheArctic/Rwork/PVM_FWSprediction_uncertainty')
