merging

Author: robj411

code/scenarios/accra/master_script_rj.R

@@ -91,8 +91,8 @@ ithim_object <- run_ithim_setup(NSAMPLES = 1024,
                                 CHRONIC_DISEASE_SCALAR = c(log(1), log(1.2)),  
                                 BACKGROUND_PA_SCALAR = c(log(1), log(1.2)),   
                                 MC_TO_CAR_RATIO = c(-1.4,0.4),
-                                PA_DOSE_RESPONSE_QUANTILE = T,  
-                                AP_DOSE_RESPONSE_QUANTILE = T)
+                                PA_DOSE_RESPONSE_QUANTILE = F,  
+                                AP_DOSE_RESPONSE_QUANTILE = F)
 
 numcores <- detectCores()
 ithim_object$outcomes <- mclapply(1:NSAMPLES, FUN = ithim_uncertainty, ithim_object = ithim_object, mc.cores = ifelse(Sys.info()[['sysname']] == "Windows",  1,  numcores))

code/scenarios/sao paulo/streamline_travel_survey.R

@@ -47,14 +47,12 @@ rd <- rename(rd, participant_id = ID_PESS ,
 # Recode modes as strings
 mode_df <- data.frame(
   mode_int = append(c(1:17), NA),
-  mode_string = c(rep('bus', 5), 'car_driver', 
-                  'car_passenger', 'taxi',
-                  rep('van', 3), 'subway',
+  mode_string = c(rep('bus', 5), rep('car', 2), 
+                  'taxi', rep('van', 3), 
+                  'subway',
                   'train', 'motorbike',
                   'bicycle', 'walk', 'others', NA)
 
-  
-  
 )
 
 # Convert numeric to string modes
@@ -76,10 +74,27 @@ ggplot(rd %>%
   geom_text(aes(label = perc), position = position_dodge(width=0.9), vjust=-0.25, color = "blue") +
   theme_minimal() +
   theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
-  labs(x = "", y = "percentage(%)", title = "Main Mode distribution")
+  labs(x = "", y = "percentage(%)", title = "Main Mode distribution - without weights")
+# )
+
+sum_total_trip_weight <- sum(rd$FE_VIA, na.rm = T)
+
+# plotly::ggplotly(
+ggplot(rd %>% 
+         filter(!is.na(trip_mode)) %>% 
+         group_by(trip_mode) %>% 
+         summarise(sum_trip_weights = sum(FE_VIA)) %>% 
+         mutate(perc = round(sum_trip_weights/sum(sum_trip_weights) * 100, 1)), 
+       aes(x = trip_mode, y = perc)) + 
+  geom_bar(position = 'dodge', stat='identity') +
+  geom_text(aes(label = perc), position = position_dodge(width=0.9), vjust=-0.25, color = "blue") +
+  theme_minimal() +
+  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
+  labs(x = "", y = "percentage(%)", title = "Main Mode distribution - with weights")
 # )
 
 
+
 # Define distance categories
 dist_cat <- c("0-6 km", "7-9 km", "10+ km")
 
@@ -99,4 +114,33 @@ ggplot(rd %>%
   geom_text(aes(label = perc), position = position_dodge(width=0.9), vjust=-0.25, color = "blue") +
   theme_minimal() +
   theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
-  labs(x = "", y = "percentage(%)", title = "Main Mode Distance distribution")
+  labs(x = "", y = "percentage(%)", title = "Main Mode Distance distribution")
+
+# Calculate mode speed from the dataset, but using mean distance and duration
+# Remove all trips with multiple modes
+# Using only commute mode as a proxy
+mode_speed <- rd %>% filter(is.na(MODO2) & is.na(MODO3) & is.na(MODO4) &  
+              ((MOTIVO_O %in% c(1, 2, 3) & MOTIVO_D %in% 8) | 
+              (MOTIVO_D %in% c(1, 2, 3) & MOTIVO_O %in% 8))
+             ) %>% group_by(trip_mode) %>% 
+  summarise(mean (trip_distance), 
+            speed = (mean(trip_distance)) / (mean(trip_duration) / 60))
+
+
+# source_modes <- c('Bus', 'Walking')
+# target_modes <- c('Private Car')
+# 
+# source_percentages <- c(0.16, 0.49)
+# 
+# tt <- nrow(filter(rdr, ! trip_mode %in% c('99', 'Short Walking')))
+# 
+# rdr <- create_scenario(rdr, scen_name = 'Scenario 1', source_modes = source_modes, 
+#                        target_modes = target_modes, source_distance_cats = dist_cat, 
+#                        source_trips = c(round(source_percentages[1] * tt), 
+#                                         round(source_percentages[2] * tt)))
+# 
+# rdfinal <- rbind(rd, rdr)
+
+#rdr %>% filter(rdfinal, scenario == 'Scenario 1' & ! trip_mode %in% c('Short Walking', "99", "Train", "Other", "Unspecified")) %>% 
+#  group_by(trip_mode) %>%  summarise(count = n(), pert = n() / nrow(.) * 100)
+

ithim_r_functions.R

@@ -181,8 +181,6 @@ ithim_setup_parameters <- function(NSAMPLES = 1,
       for(age in unique(dr_ap$age_code)){
         dr_ap_age <- subset(dr_ap,age_code==age)
         #######################################
-        
-        
         lbeta <- log(dr_ap_age$beta)
         lgamma <- log(dr_ap_age$gamma)
         gamma_val <- quantile(density(lgamma),quant1)
@@ -393,7 +391,7 @@ edit_accra_trips <- function(raw_trip_set){
   total_mc_distance <- total_car_distance*VEHICLE_INVENTORY$distance_ratio_to_car[VEHICLE_INVENTORY$trip_mode==new_mode]
   mc_duration <- total_mc_distance/VEHICLE_INVENTORY$speed[VEHICLE_INVENTORY$trip_mode==new_mode]*60
   residual_mc_duration <- mc_duration - sum(subset(raw_trip_set,trip_mode==new_mode)$trip_duration)
-  duration_range <- 15:100
+  #duration_range <- 15:100
   nTrips <- 1
   nPeople <- 20#round(residual_mc_duration/nTrips/mean(duration_range))
   duration <- residual_mc_duration/nPeople
@@ -636,7 +634,6 @@ create_all_scenarios <- function(trip_set){
   mcycle_trips_sample <- create_scenario(rdr, scen_name = 'Scenario 3', source_modes = source_modes, 
                                          combined_modes = T, target_modes = target_modes, 
                                          source_distance_cats = DIST_CAT, source_trips = target_new_trips)
-  
   # Update selected rows for mode and duration
   rdr$trip_mode[match(mcycle_trips_sample$row_id,rdr$row_id)] <- mcycle_trips_sample$trip_mode
   rdr$trip_duration[match(mcycle_trips_sample$row_id,rdr$row_id)] <- mcycle_trips_sample$trip_duration
@@ -1219,7 +1216,6 @@ combined_rr_pa_pa <- function(ind_pa,ind_ap){
 }
 
 injuries_function_2 <- function(true_distances,injuries_list,reg_model){
-
   ## For predictive uncertainty, we could sample a number from the predicted distribution
   injuries <- true_distances
   injuries$Bus_driver <- 0