Merge pull request #164 from Caliper-Corporation/dev

Move dev into main for release candidate

.gitignore

@@ -12,3 +12,8 @@ docs/site_libs/*
 docs/data/input/ieei/AMSOVDistanceSkim.csv
 docs/data/input/university/AMSOVDistanceSkim.csv
 trmg2.scenarios
+*.DCC
+docs/data/output/university/university_model_summaries/data/interim/*
+!docs/data/output/university/university_model_summaries/data/interim/home_to_campus_trip_length.csv
+!docs/data/output/university/university_model_summaries/data/interim/university_mode_shares.csv
+!docs/data/output/university/university_model_summaries/data/interim/university_summary.csv

docs/R/ieei.R

@@ -4,12 +4,12 @@ data_dir <- "data/input/ieei/"
 output_dir <- "data/output/ieei/"
 master_dir <- "../master/"
 
-
 taz_shape_filename <- paste0(master_dir, "tazs/master_tazs.shp")
 socec_filename <- paste0(data_dir, "se_2016.csv")
 consolidated_streetlight_filename <- paste0(private_dir, "streetlight-ieei-flows.RDS")
 ncstm_filename <- paste0(data_dir, "ncstm-demand.rds")
 distance_filename <- paste0(data_dir, "distance-skim.RDS")
+demand_filename <- paste0(output_dir, "ieei_demand.RDS")
 
 output_ee_seed_filename <- paste0(output_dir, "ee-seed.csv")
 output_ei_attractions_filename <- paste0(output_dir, "ei-attractions.csv")
@@ -34,6 +34,8 @@ taz_sf <- st_read(taz_shape_filename) %>%
 
 distance_df <- readRDS(distance_filename)
 
+estimated_df <- readRDS(demand_filename)
+
 # StreetLight: External station shares -----------------------------------------
 working_df <- sl_df %>%
   filter(purpose == "XX" & source == "itre") %>%
@@ -314,9 +316,19 @@ ei_attractions_df <- working_df %>%
 ei_distance_df <- working_df %>%
   filter(observed_trips > 0.0) %>%
   left_join(., distance_df, by = c("orig_taz" = "orig", "dest_taz" = "dest")) %>%
+  left_join(., estimated_df, by = c("orig_taz", "dest_taz")) %>%
   mutate(category = "Non-freeway") %>%
   mutate(category = if_else(purpose == "IX" & (dest_taz %in% freeway_station_vector), "Freeway", category)) %>%
-  mutate(category = if_else(purpose == "XI" & (orig_taz %in% freeway_station_vector), "Freeway", category))
+  mutate(category = if_else(purpose == "XI" & (orig_taz %in% freeway_station_vector), "Freeway", category)) 
+
+ei_distance_means_df <- bind_rows(
+  mutate(select(ei_distance_df, orig_taz, dest_taz, purpose, category, distance, trips = observed_trips), source = "Observed"),
+  mutate(select(ei_distance_df, orig_taz, dest_taz, purpose, category, distance, trips = estimated), source = "Estimated")) %>%
+  mutate(trips = replace_na(trips, 0.0)) %>%
+  group_by(category, source) %>%
+  summarise(mean_distance = weighted.mean(distance, trips), .groups = "drop") %>%
+  arrange(category)
+
 
 write_csv(ei_attractions_df, file = output_ei_attractions_filename)
 write_csv(ei_distance_df, file = output_ei_distance_filename)

docs/R/make_ieei_distance_skim.R

@@ -1,13 +1,4 @@
-# Packages ---------------------------------------------------------------------
-packages_vector <- c("tidyverse")
-
-need_to_install <- packages_vector[!(packages_vector %in% installed.packages()[,"Package"])]
-
-if (length(need_to_install)) install.packages(need_to_install)
-
-for (package in packages_vector) {
-  library(package, character.only = TRUE)
-}
+library(tidyverse)
 
 # Remote I/O -------------------------------------------------------------------
 private_dir <- "data/_PRIVATE/"

docs/R/university_attractions.R

@@ -0,0 +1,92 @@
+# Packages ---------------------------------------------------------------------
+library(tidyverse)
+library(corrr)
+library(kableExtra)
+library(broom)
+
+# Remote I/O -------------------------------------------------------------------
+
+private_dir <- "data/input/_PRIVATE/"
+input_dir <-"data/input/university/"
+univ_dir<-"data/output/university/"
+
+# Data Reads -------------------------------------------------------------------
+
+Attractions_byTAZbySegment_df<-readRDS(paste0(private_dir,"Attractions_byTAZbySegment_df.RDS"))
+Attractions_byTAZ_df<-readRDS(paste0(private_dir,"Attractions_byTAZ_df.RDS"))
+Trip_subset_df<-readRDS(paste0(private_dir,"Trip_subset_df.RDS"))
+Person_subset_df<-readRDS(paste0(private_dir,"Person_subset_df.RDS"))
+socioecon2_df<-readRDS(paste0(input_dir,"socioecon2_df.RDS"))
+
+# Correlations -----------------------------------------------------------------
+correlations_df <- Attractions_byTAZ_df %>%
+  select(AllStudents_Trips,
+         OnCampusStudents_UHOTrips,
+         OffCampusStudents_UHOTrips,
+         AllStudents_UCOTrips,
+         AllStudents_UOOTrips,
+         AllStudents_UHOUCOTrips,
+         AllStudents_Trips,
+         Households = HH,
+         'NCSU Student Group Quarter Population' = StudGQ_NCSU,
+         'NCSU Off-campus Student Population' = StudOff_NCSU,
+         'UNC Student Group Quarters Population' = StudGQ_UNC,
+         'Total Population' = Total_POP_rem,
+         'Total Employment' = employment,
+         'Industrial Employment' = Industry,
+         'Office Employment' = Office,
+         'Service Employment (High)' = Service_RateHigh,
+         'Service Employment (Low)' = Service_RateLow,
+         'Retail Employment' = Retail) %>%
+  correlate() 
+
+
+# Regression models ------------------------------------------------------------------------------------
+
+
+# Productions on-campus & Attractions off-campus -------------------------------------------------------
+### UCO (Campus-Other) Trips by On-Campus Students
+### use model 3
+Model_UCO_1 = lm(AllStudents_UCOTrips ~ StudOff_NCSU, data = Attractions_byTAZ_df)
+tidy(Model_UCO_1)
+
+Model_UCO_2 = lm(AllStudents_UCOTrips ~ StudOff_NCSU + Retail,  data = Attractions_byTAZ_df)
+tidy(Model_UCO_2)
+
+apply_Model_OnCampusUCO_2 <- Attractions_byTAZ_df %>% 
+    mutate(Predicted = 
+             Model_UCO_2$coefficients["(Intercept)"] + 
+             Model_UCO_2$coefficients["StudOff_NCSU"] * StudOff_NCSU + 
+             Model_UCO_2$coefficients["Retail"] * Retail)
+
+plot_Model_UCO_2 <- apply_Model_OnCampusUCO_2 %>%
+    ggplot(aes(OnCampusStudents_UCOTrips,Predicted)) +
+    geom_point()
+
+Model_UCO_3 = lm(AllStudents_UCOTrips ~ StudOff_NCSU + Retail + avg_distance_NCSU,  data = Attractions_byTAZ_df)
+tidy(Model_UCO_3)
+
+Model_UCO_4 = lm(AllStudents_UCOTrips ~ StudOff_NCSU + Retail + min_distance_NCSU,  data = Attractions_byTAZ_df)
+tidy(Model_UCO_4)
+
+### UHO (Home=Campus - Other )Trips by On-Campus Students 
+
+Model_Oncampus_UHO_1= lm(OnCampusStudents_UHOTrips ~ StudOff_NCSU + Retail , data = Attractions_byTAZ_df)
+tidy(Model_Oncampus_UHO_1)
+
+Model_Oncampus_UHO_2= lm(OnCampusStudents_UHOTrips ~ StudOff_NCSU + Retail + avg_distance_NCSU , data = Attractions_byTAZ_df)
+tidy(Model_Oncampus_UHO_2)
+
+
+
+# Regression models - Production and Attraction Off-campus-----------------------------------------------------------
+
+### UHO Trips by Off-Campus Students
+Model_Offcampus_UHO_1 = lm(OffCampusStudents_UHOTrips ~ StudOff_NCSU , data = Attractions_byTAZ_df)
+tidy(Model_Offcampus_UHO_1)
+summary(Model_Offcampus_UHO_1)
+
+Model_Offcampus_UHO_2 = lm(OffCampusStudents_UHOTrips ~ StudOff_NCSU + Retail , data = Attractions_byTAZ_df)
+tidy(Model_Offcampus_UHO_2)
+summary(Model_Offcampus_UHO_2)
+