```{r label="libraries-and-vars",echo=FALSE,results='hide',message=FALSE} library(foreign) library(plyr) library(ggplot2) zones_oki<-2299 zones_mv<-3206 ``` ```{r label="Read Data", echo=FALSE, results='markup', message=FALSE,cache=TRUE} tripspk<-read.dbf('PeakDist.DBF') tripsop<-read.dbf('OffPeakDist.DBF') #I,J,M,HBWPK,HBUPK,HBSHPK,HBSRPK,HBOPK,HBWPKLS,HBUPKLS,HBSHPKLS,HBSRPKLS,HBOPKLS,HBWOPLS,HBUOPLS,HBSHOPLS,HBSROPLS,HBOOPLS obstrips<-read.csv('HomeBasedTripsLogsums.csv') #ID,HHSIZE,Source,TripID,Workers,HHVEH,INCOME,GENDER,oTAZ,dTAZ,OSD,DSD,EmpType,Access,IsStudent,Tod,Egress,Weight,OACT3 #DACT3,TripPurp,TP_Text,modecat,CombinedWeight,CombinedFinalWeight,Logsum ``` ```{r label="summarize-model-data", echo=FALSE, results='hide',cache=TRUE} tripspk$fls_hbwpk<-floor(tripspk$HBWPKLS) tripspk$fls_hbupk<-floor(tripspk$HBUPKLS) tripspk$fls_hbshpk<-floor(tripspk$HBSHPKLS) tripspk$fls_hbsrpk<-floor(tripspk$HBSRPKLS) tripspk$fls_hbopk<-floor(tripspk$HBOPKLS) tripsop$fls_hbwop<-floor(tripsop$HBWOPLS) tripsop$fls_hbuop<-floor(tripsop$HBUOPLS) tripsop$fls_hbshop<-floor(tripsop$HBSHOPLS) tripsop$fls_hbsrop<-floor(tripsop$HBSROPLS) tripsop$fls_hboop<-floor(tripsop$HBOOPLS) okitripspk<-subset(tripspk,I<=zones_oki & J<=zones_oki & I!=J) okitripsop<-subset(tripsop,I<=zones_oki & J<=zones_oki & I!=J) hbwpktlf_ls.oki<-ddply(okitripspk,.(fls_hbwpk),summarize,tot=length(fls_hbwpk),pct=tot/length(okitripspk$HBWPK)) hbupktlf_ls.oki<-ddply(okitripspk,.(fls_hbupk),summarize,tot=length(fls_hbupk),pct=tot/length(okitripspk$HBUPKLS)) hbshpktlf_ls.oki<-ddply(okitripspk,.(fls_hbshpk),summarize,tot=length(fls_hbshpk),pct=tot/length(okitripspk$HBSHPKLS)) hbsrpktlf_ls.oki<-ddply(okitripspk,.(fls_hbsrpk),summarize,tot=length(fls_hbsrpk),pct=tot/length(okitripspk$HBSRPKLS)) hbopktlf_ls.oki<-ddply(okitripspk,.(fls_hbopk),summarize,tot=length(fls_hbopk),pct=tot/length(okitripspk$HBOPKLS)) hbwoptlf_ls.oki<-ddply(okitripsop,.(fls_hbwop),summarize,tot=length(fls_hbwop),pct=tot/length(okitripsop$HBWOPLS)) hbuoptlf_ls.oki<-ddply(okitripsop,.(fls_hbuop),summarize,tot=length(fls_hbuop),pct=tot/length(okitripsop$HBUOPLS)) hbshoptlf_ls.oki<-ddply(okitripsop,.(fls_hbshop),summarize,tot=length(fls_hbsrop),pct=tot/length(okitripsop$HBSHOPLS)) hbsroptlf_ls.oki<-ddply(okitripsop,.(fls_hbsrop),summarize,tot=length(fls_hbshop),pct=tot/length(okitripsop$HBSROPLS)) hbooptlf_ls.oki<-ddply(okitripsop,.(fls_hboop),summarize,tot=length(fls_hboop),pct=tot/length(okitripsop$HBOOPLS)) ``` ```{r label="summarize-observed-data",echo=FALSE, results='hide',cache=TRUE} obstrips$rls<-floor(obstrips$Logsum) obstripspk<-subset(obstrips,(Tod=="AM Peak" | Tod=="PM Peak") & oTAZ!=dTAZ) obstripsop<-subset(obstrips,(Tod!="AM Peak" & Tod!="PM Peak") & oTAZ!=dTAZ) obshbwpk<-subset(obstripspk,TP_Text=='HBW') obshbupk<-subset(obstripspk,TP_Text=='HBU') obshbshpk<-subset(obstripspk,TP_Text=='HBSh') obshbsrpk<-subset(obstripspk,TP_Text=='HBSoc') obshbopk<-subset(obstripspk,TP_Text=='HBO') obshbwop<-subset(obstripsop,TP_Text=='HBW') obshbuop<-subset(obstripsop,TP_Text=='HBU') obshbshop<-subset(obstripsop,TP_Text=='HBSh') obshbsrop<-subset(obstripsop,TP_Text=='HBSoc') obshboop<-subset(obstripsop,TP_Text=='HBO') obshbwpktlf_ls.oki<-ddply(obshbwpk,.(rls),summarize,tot=length(rls),pct=tot/length(obshbwpk$TP_Text=="HBW")) obshbupktlf_ls.oki<-ddply(obshbupk,.(rls),summarize,tot=length(rls),pct=tot/length(obshbupk$TP_Text=="HBU")) obshbshpktlf_ls.oki<-ddply(obshbshpk,.(rls),summarize,tot=length(rls),pct=tot/length(obshbshpk$TP_Text=="HBSh")) obshbsrpktlf_ls.oki<-ddply(obshbsrpk,.(rls),summarize,tot=length(rls),pct=tot/length(obshbsrpk$TP_Text=="HBSoc")) obshbopktlf_ls.oki<-ddply(obshbopk,.(rls),summarize,tot=length(rls),pct=tot/length(obshbopk$TP_Text=="HBO")) obshbwoptlf_ls.oki<-ddply(obshbwop,.(rls),summarize,tot=length(rls),pct=tot/length(obshbwop$TP_Text=="HBW")) obshbuoptlf_ls.oki<-ddply(obshbuop,.(rls),summarize,tot=length(rls),pct=tot/length(obshbuop$TP_Text=="HBU")) obshbshoptlf_ls.oki<-ddply(obshbshop,.(rls),summarize,tot=length(rls),pct=tot/length(obshbshop$TP_Text=="HBSh")) obshbsroptlf_ls.oki<-ddply(obshbsrop,.(rls),summarize,tot=length(rls),pct=tot/length(obshbsrop$TP_Text=="HBSoc")) obshbooptlf_ls.oki<-ddply(obshboop,.(rls),summarize,tot=length(rls),pct=tot/length(obshboop$TP_Text=="HBO")) ``` Peak Period Trip Length Frequency - OKI Region ======================================================== OKI HBW Peak Period -------------------------------------------------------- ```{r hbwpk-oki-chart, echo=FALSE, fig.width=8,fig.height=4} ggplot()+geom_line(data=obshbwpktlf_ls.oki,aes(x=rls,y=pct,colour="#CC0000"))+xlab("Logsum")+ylab("Percent")+geom_line(data=hbwpktlf_ls.oki,aes(x=fls_hbwpk,y=pct,xmin=0,ymin=0,colour="#000000"))+ggtitle("OKI HBW Peak Period Logsum Frequency")+xlim(0,1600)+scale_colour_manual(name="",values=c("#000000","#CC0000"),labels=c("Modeled","Observed")) hbwpktlf_ls.oki$rls<-hbwpktlf_ls.oki$fls_hbwpk hbwpkcr<-merge(hbwpktlf_ls.oki,obshbwpktlf_ls.oki,by="rls") hbwpkcr$mins<-min(hbwpkcr$pct.x,hbwpkcr$pct.y) hbwpkcr$maxs<-max(hbwpkcr$pct.x,hbwpkcr$pct.y) ``` The coincidence ratio is `r (sum(hbwpkcr$mins)/sum(hbwpkcr$maxs))*100`% OKI HBU Peak Period -- ```{r hbupk-oki-chart, echo=FALSE, fig.width=8,fig.height=4} ggplot()+geom_line(data=obshbupktlf_ls.oki,aes(x=rls,y=pct,colour="#CC0000"))+xlab("Logsum")+ylab("Percent")+geom_line(data=hbupktlf_ls.oki,aes(x=fls_hbupk,y=pct,xmin=0,ymin=0,colour="#000000"))+ggtitle("OKI HBU Peak Period Logsum Frequency")+xlim(0,1600)+scale_colour_manual(name="",values=c("#000000","#CC0000"),labels=c("Modeled","Observed")) hbupktlf_ls.oki$rls<-hbupktlf_ls.oki$fls_hbupk hbupkcr<-merge(hbupktlf_ls.oki,obshbupktlf_ls.oki,by="rls") hbupkcr$mins<-min(hbupkcr$pct.x,hbupkcr$pct.y) hbupkcr$maxs<-max(hbupkcr$pct.x,hbupkcr$pct.y) ``` The coincidence ratio is `r (sum(hbupkcr$mins)/sum(hbupkcr$maxs))*100`% OKI HBSH Peak Period -- ```{r hbshpk-oki-chart, echo=FALSE, fig.width=8,fig.height=4} ggplot()+geom_line(data=obshbshpktlf_ls.oki,aes(x=rls,y=pct,colour="#CC0000"))+xlab("Logsum")+ylab("Percent")+geom_line(data=hbshpktlf_ls.oki,aes(x=fls_hbshpk,y=pct,xmin=0,ymin=0,colour="#000000"))+ggtitle("OKI HBSH Peak Period Logsum Frequency")+xlim(0,1600)+scale_colour_manual(name="",values=c("#000000","#CC0000"),labels=c("Modeled","Observed")) hbshpktlf_ls.oki$rls<-hbshpktlf_ls.oki$fls_hbshpk hbshpkcr<-merge(hbshpktlf_ls.oki,obshbshpktlf_ls.oki,by="rls") hbshpkcr$mins<-min(hbshpkcr$pct.x,hbshpkcr$pct.y) hbshpkcr$maxs<-max(hbshpkcr$pct.x,hbshpkcr$pct.y) ``` The coincidence ratio is `r (sum(hbshpkcr$mins)/sum(hbshpkcr$maxs))*100`% OKI HBSR Peak Period -- ```{r hbsrpk-oki-chart, echo=FALSE, fig.width=8,fig.height=4} ggplot()+geom_line(data=obshbsrpktlf_ls.oki,aes(x=rls,y=pct,colour="#CC0000"))+xlab("Logsum")+ylab("Percent")+geom_line(data=hbsrpktlf_ls.oki,aes(x=fls_hbsrpk,y=pct,xmin=0,ymin=0,colour="#000000"))+ggtitle("OKI HBSR Peak Period Logsum Frequency")+xlim(0,1600)+scale_colour_manual(name="",values=c("#000000","#CC0000"),labels=c("Modeled","Observed")) hbsrpktlf_ls.oki$rls<-hbsrpktlf_ls.oki$fls_hbsrpk hbsrpkcr<-merge(hbsrpktlf_ls.oki,obshbsrpktlf_ls.oki,by="rls") hbsrpkcr$mins<-min(hbsrpkcr$pct.x,hbsrpkcr$pct.y) hbsrpkcr$maxs<-max(hbsrpkcr$pct.x,hbsrpkcr$pct.y) ``` The coincidence ratio is `r (sum(hbsrpkcr$mins)/sum(hbsrpkcr$maxs))*100`% OKI HBO Peak Period -- ```{r hbopk-oki-chart, echo=FALSE, fig.width=8,fig.height=4} ggplot()+geom_line(data=obshbopktlf_ls.oki,aes(x=rls,y=pct,colour="#CC0000"))+xlab("Logsum")+ylab("Percent")+geom_line(data=hbopktlf_ls.oki,aes(x=fls_hbopk,y=pct,xmin=0,ymin=0,colour="#000000"))+ggtitle("OKI HBO Peak Period Logsum Frequency")+xlim(0,1600)+scale_colour_manual(name="",values=c("#000000","#CC0000"),labels=c("Modeled","Observed")) hbopktlf_ls.oki$rls<-hbopktlf_ls.oki$fls_hbopk hbopkcr<-merge(hbopktlf_ls.oki,obshbopktlf_ls.oki,by="rls") hbopkcr$mins<-min(hbopkcr$pct.x,hbopkcr$pct.y) hbopkcr$maxs<-max(hbopkcr$pct.x,hbopkcr$pct.y) ``` The coincidence ratio is `r (sum(hbopkcr$mins)/sum(hbopkcr$maxs))*100`% Off-Peak Period Trip Length Frequency - OKI Region ======================================================== OKI HBW Off-Peak Period -------------------------------------------------------- ```{r hbwop-oki-chart, echo=FALSE, fig.width=8,fig.height=4} ggplot()+geom_line(data=obshbwoptlf_ls.oki,aes(x=rls,y=pct,colour="#CC0000"))+xlab("Logsum")+ylab("Percent")+geom_line(data=hbwoptlf_ls.oki,aes(x=fls_hbwop,y=pct,xmin=0,ymin=0,colour="#000000"))+ggtitle("OKI HBW Off-Peak Period Logsum Frequency")+xlim(0,1600)+scale_colour_manual(name="",values=c("#000000","#CC0000"),labels=c("Modeled","Observed")) hbwoptlf_ls.oki$rls<-hbwoptlf_ls.oki$fls_hbwop hbwopcr<-merge(hbwoptlf_ls.oki,obshbwoptlf_ls.oki,by="rls") hbwopcr$mins<-min(hbwopcr$pct.x,hbwopcr$pct.y) hbwopcr$maxs<-max(hbwopcr$pct.x,hbwopcr$pct.y) ``` The coincidence ratio is `r (sum(hbwopcr$mins)/sum(hbwopcr$maxs))*100`% OKI HBU Off-Peak Period -- ```{r hbuop-oki-chart, echo=FALSE, fig.width=8,fig.height=4} ggplot()+geom_line(data=obshbuoptlf_ls.oki,aes(x=rls,y=pct,colour="#CC0000"))+xlab("Logsum")+ylab("Percent")+geom_line(data=hbuoptlf_ls.oki,aes(x=fls_hbuop,y=pct,xmin=0,ymin=0,colour="#000000"))+ggtitle("OKI HBU Off-Peak Period Logsum Frequency")+xlim(0,1600)+scale_colour_manual(name="",values=c("#000000","#CC0000"),labels=c("Modeled","Observed")) hbuoptlf_ls.oki$rls<-hbuoptlf_ls.oki$fls_hbuop hbuopcr<-merge(hbuoptlf_ls.oki,obshbuoptlf_ls.oki,by="rls") hbuopcr$mins<-min(hbuopcr$pct.x,hbuopcr$pct.y) hbuopcr$maxs<-max(hbuopcr$pct.x,hbuopcr$pct.y) ``` The coincidence ratio is `r (sum(hbuopcr$mins)/sum(hbuopcr$maxs))*100`% OKI HBSH Off-Peak Period -- ```{r hbshop-oki-chart, echo=FALSE, fig.width=8,fig.height=4} ggplot()+geom_line(data=obshbshoptlf_ls.oki,aes(x=rls,y=pct,colour="#CC0000"))+xlab("Logsum")+ylab("Percent")+geom_line(data=hbshoptlf_ls.oki,aes(x=fls_hbshop,y=pct,xmin=0,ymin=0,colour="#000000"))+ggtitle("OKI HBSH Off-Peak Period Logsum Frequency")+xlim(0,1600)+scale_colour_manual(name="",values=c("#000000","#CC0000"),labels=c("Modeled","Observed")) hbshoptlf_ls.oki$rls<-hbshoptlf_ls.oki$fls_hbshop hbshopcr<-merge(hbshoptlf_ls.oki,obshbshoptlf_ls.oki,by="rls") hbshopcr$mins<-min(hbshopcr$pct.x,hbshopcr$pct.y) hbshopcr$maxs<-max(hbshopcr$pct.x,hbshopcr$pct.y) ``` The coincidence ratio is `r (sum(hbshopcr$mins)/sum(hbshopcr$maxs))*100`% OKI HBSR Off-Peak Period -- ```{r hbsrop-oki-chart, echo=FALSE, fig.width=8,fig.height=4} ggplot()+geom_line(data=obshbsroptlf_ls.oki,aes(x=rls,y=pct,colour="#CC0000"))+xlab("Logsum")+ylab("Percent")+geom_line(data=hbsroptlf_ls.oki,aes(x=fls_hbsrop,y=pct,xmin=0,ymin=0,colour="#000000"))+ggtitle("OKI HBSR Off-Peak Period Logsum Frequency")+xlim(0,1600)+scale_colour_manual(name="",values=c("#000000","#CC0000"),labels=c("Modeled","Observed")) hbsroptlf_ls.oki$rls<-hbsroptlf_ls.oki$fls_hbsrop hbsropcr<-merge(hbsroptlf_ls.oki,obshbsroptlf_ls.oki,by="rls") hbsropcr$mins<-min(hbsropcr$pct.x,hbsropcr$pct.y) hbsropcr$maxs<-max(hbsropcr$pct.x,hbsropcr$pct.y) ``` The coincidence ratio is `r (sum(hbsropcr$mins)/sum(hbsropcr$maxs))*100`% OKI HBO Off-Peak Period -- ```{r hboop-oki-chart, echo=FALSE, fig.width=8,fig.height=4} ggplot()+geom_line(data=obshbooptlf_ls.oki,aes(x=rls,y=pct,colour="#CC0000"))+xlab("Logsum")+ylab("Percent")+geom_line(data=hbooptlf_ls.oki,aes(x=fls_hboop,y=pct,xmin=0,ymin=0,colour="#000000"))+ggtitle("OKI HBO Off-Peak Period Logsum Frequency")+xlim(0,1600)+scale_colour_manual(name="",values=c("#000000","#CC0000"),labels=c("Modeled","Observed")) hbooptlf_ls.oki$rls<-hbooptlf_ls.oki$fls_hboop hboopcr<-merge(hbooptlf_ls.oki,obshbooptlf_ls.oki,by="rls") hboopcr$mins<-min(hboopcr$pct.x,hboopcr$pct.y) hboopcr$maxs<-max(hboopcr$pct.x,hboopcr$pct.y) ``` The coincidence ratio is `r (sum(hboopcr$mins)/sum(hboopcr$maxs))*100`%