Original data files

The data file used for this analysis was created by combining data from the following spreadsheets provided by technical consultant Dr. Bruce Johnson. Data for US-41 and CR-846 are from Copy of retrospective_traffic_data_updated_20201021.xlsx and data from SR-29, SR-82, and Church Road are from Copy of PTMS AADT history_20200921.xlsx.

Plots of raw data

Scatter plots of AADT vs PVM faceted by road segment

5 year average PVM

Log-log scale

Log-log scale with lm lines

Confidence bands are included, but should be interpreted with caution given lack of independence due to use of moving averages for PVM.

Log-log scale with loess smooth lines

Confidence bands are included, but should be interpreted with caution given lack of independence due to use of moving averages for PVM.

Same x-scales to show limited range of AADT

Simple Linear Regression results

These results are exploratory only and should be interpreted with caution given use of overlapping moving averages for PVM.

# Fille in the segment_source of interest: 
# Options are: "SR-29 CC-MS2", "SR-29 FDOT", "SR-82 FDOT", "CR-846 FDOT", "US-41 FDOT", "Church Rd FDOT"
ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="SR-29 CC-MS2"))
#ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="SR-29 FDOT"))
#ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="SR-82 FDOT"))
#ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="CR-846 FDOT"))
#ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="US-41 FDOT"))
#ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="Church Rd FDOT"))

summary(ll_slr_out)
## 
## Call:
## lm(formula = ln_MA5_PVM ~ ln_AADT_1000, data = dplyr::filter(seg_df, 
##     segment_source == "SR-29 CC-MS2"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -0.9999 -0.1009  0.0247  0.1150  0.7966 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)
## (Intercept)    -5.820      1.321  -4.406  0.00227
## ln_AADT_1000    3.831      1.114   3.440  0.00883
## 
## Residual standard error: 0.4962 on 8 degrees of freedom
##   (2 observations deleted due to missingness)
## Multiple R-squared:  0.5966, Adjusted R-squared:  0.5462 
## F-statistic: 11.83 on 1 and 8 DF,  p-value: 0.008826
confint(ll_slr_out, level=0.95)
##                  2.5 %    97.5 %
## (Intercept)  -8.865457 -2.774009
## ln_AADT_1000  1.262890  6.399776
confint(ll_slr_out, level=0.99)
##                     0.5 %    99.5 %
## (Intercept)  -10.25146167 -1.388004
## ln_AADT_1000   0.09408043  7.568586

Check autocorrelation - evidence of lag 1 auto-regressive (AR-1) positive autocorrelation in raw ln_MA5PVM data, as would be expected, but not in the residuals.

Compare SLR to FREM predictions informally

This is just exploratory work to get a sense of the size of the predictions and prediction intervals from such an approach. This points to the effects of the extrapolations on the predictions. Each segment is looked at individually, though could look at collection to get an even better idea of the aggregation of the errors.

#Need to fit the lm to every segment and collect all the predictions
# Should write a function, but will probably just refit for the 5 segments given time
ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="SR-29 CC-MS2"))
ll_newdata_df <- data.frame(YEAR=2060, ln_AADT_1000=log(future_data$AADT_2060[1]/1000), ln_MA5_PVM=NA)
est_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="confidence")
pred_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.95)
#pred_2060_lm1  #standard errors are still of the fitted values, but intervals corrected for prediction

pred_2060_lm2 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.99)
#pred_2060_lm2

pred_int95 <- exp(pred_2060_lm1$fit)
pred_int99 <- exp(pred_2060_lm2$fit)
pred_int95 
##       fit      lwr      upr
## 1 391.692 2.573587 59614.31
pred_int99 
##       fit       lwr      upr
## 1 391.692 0.2614575 586797.7
#Need to fit the lm to every segment and collect all the predictions
# Should write a function, but will probably just refit for the 5 segments given time
ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="SR-29 FDOT"))
ll_newdata_df <- data.frame(YEAR=2060, ln_AADT_1000=log(future_data$AADT_2060[1]/1000), ln_MA5_PVM=NA)
est_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="confidence")
pred_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.95)
#pred_2060_lm1  #standard errors are still of the fitted values, but intervals corrected for prediction

pred_2060_lm2 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.99)
#pred_2060_lm2

pred_int95 <- exp(pred_2060_lm1$fit)
pred_int99 <- exp(pred_2060_lm2$fit)
pred_int95 
##         fit        lwr      upr
## 1 0.3742276 0.03593579 3.897125
pred_int99 
##         fit        lwr      upr
## 1 0.3742276 0.01548916 9.041566
#Need to fit the lm to every segment and collect all the predictions
# Should write a function, but will probably just refit for the 5 segments given time
ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="SR-82 FDOT"))
ll_newdata_df <- data.frame(YEAR=2060, ln_AADT_1000=log(future_data$AADT_2060[2]/1000), ln_MA5_PVM=NA)
est_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="confidence")
pred_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.95)
#pred_2060_lm1  #standard errors are still of the fitted values, but intervals corrected for prediction

pred_2060_lm2 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.99)
#pred_2060_lm2

pred_int95 <- exp(pred_2060_lm1$fit)
pred_int99 <- exp(pred_2060_lm2$fit)
pred_int95 
##        fit       lwr     upr
## 1 1.474867 0.1783914 12.1936
pred_int99 
##        fit        lwr      upr
## 1 1.474867 0.08353617 26.03942
#Need to fit the lm to every segment and collect all the predictions
# Should write a function, but will probably just refit for the 5 segments given time
ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="Church Rd FDOT"))
ll_newdata_df <- data.frame(YEAR=2060, ln_AADT_1000=log(future_data$AADT_2060[3]/1000), ln_MA5_PVM=NA)
est_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="confidence")
pred_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.95)
#pred_2060_lm1  #standard errors are still of the fitted values, but intervals corrected for prediction

pred_2060_lm2 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.99)
#pred_2060_lm2

pred_int95 <- exp(pred_2060_lm1$fit)
pred_int99 <- exp(pred_2060_lm2$fit)
pred_int95 
##   fit          lwr     upr
## 1 0.2 9.619061e-09 4158410
pred_int99
##   fit          lwr          upr
## 1 0.2 7.415019e-15 5.394457e+12
#Need to fit the lm to every segment and collect all the predictions
# Should write a function, but will probably just refit for the 5 segments given time
ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="CR-846 FDOT"))
ll_newdata_df <- data.frame(YEAR=2060, ln_AADT_1000=log(future_data$AADT_2060[4]/1000), ln_MA5_PVM=NA)
est_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="confidence")
pred_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.95)
#pred_2060_lm1  #standard errors are still of the fitted values, but intervals corrected for prediction

pred_2060_lm2 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.99)
#pred_2060_lm2

pred_int95 <- exp(pred_2060_lm1$fit)
pred_int99 <- exp(pred_2060_lm2$fit)
pred_int95 
##         fit       lwr      upr
## 1 0.6478387 0.2494381 1.682562
pred_int99
##         fit       lwr      upr
## 1 0.6478387 0.1615609 2.597752
#Need to fit the lm to every segment and collect all the predictions
# Should write a function, but will probably just refit for the 5 segments given time
ll_slr_out <- lm(ln_MA5_PVM ~ ln_AADT_1000, data=dplyr::filter(seg_df, segment_source=="US-41 FDOT"))
ll_newdata_df <- data.frame(YEAR=2060, ln_AADT_1000=log(future_data$AADT_2060[4]/1000), ln_MA5_PVM=NA)
est_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="confidence")
pred_2060_lm1 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.95)
#pred_2060_lm1  #standard errors are still of the fitted values, but intervals corrected for prediction

pred_2060_lm2 <- predict(ll_slr_out, newdata=ll_newdata_df, se.fit=TRUE, interval="prediction", level=0.99)
#pred_2060_lm2

pred_int95 <- exp(pred_2060_lm1$fit)
pred_int99 <- exp(pred_2060_lm2$fit)
pred_int95 
##        fit       lwr     upr
## 1 2.835849 0.6918183 11.6245
pred_int99
##        fit       lwr      upr
## 1 2.835849 0.4139495 19.42759