From f947b98a4d9170b222afa69bedfb8406166c7991 Mon Sep 17 00:00:00 2001
From: Anna Schroeder <anna.schroeder@outlook.de>
Date: Tue, 15 Nov 2022 14:43:09 +0000
Subject: [PATCH] Correct distances used in injury model

---
 R/get_all_distances.R | 55 +++++++++++++++++++++++++++++++++----------
 1 file changed, 42 insertions(+), 13 deletions(-)

diff --git a/R/get_all_distances.R b/R/get_all_distances.R
index b563d3ce..a21539c9 100644
--- a/R/get_all_distances.R
+++ b/R/get_all_distances.R
@@ -55,19 +55,19 @@ get_all_distances <- function(ithim_object){
   
   ## for injury_function
   # get average total distances by sex and age cat
-  journeys <- trip_scen_sets %>% 
-    group_by (age_cat,sex,stage_mode, scenario) %>% 
-    summarise(tot_dist = sum(stage_distance) / total_synth_pop)
-  trip_scen_sets <- NULL
-  
-  # Add population values by sex and age category
-  journeys <- dplyr::left_join(journeys, pop, by = c('sex', 'age_cat'))
-  
-  # Calculate total distance by population
-  journeys$tot_dist <- journeys$tot_dist * journeys$population
-  
-  # Remove additional population column
-  journeys <- journeys %>% dplyr::select(-population)
+  # journeys <- trip_scen_sets %>% 
+  #   group_by (age_cat,sex,stage_mode, scenario) %>% 
+  #   summarise(tot_dist = sum(stage_distance) / total_synth_pop)
+  # trip_scen_sets <- NULL
+  # 
+  # # Add population values by sex and age category
+  # journeys <- dplyr::left_join(journeys, pop, by = c('sex', 'age_cat'))
+  # 
+  # # Calculate total distance by population
+  # journeys$tot_dist <- journeys$tot_dist * journeys$population
+  # 
+  # # Remove additional population column
+  # journeys <- journeys %>% dplyr::select(-population)
   
   # dist <- journeys %>% group_by(stage_mode, scenario) %>% summarise(dist = sum(tot_dist)) %>% spread(scenario, dist)
   # 
@@ -78,9 +78,38 @@ get_all_distances <- function(ithim_object){
   #   dist <- dist %>% filter(stage_mode != 'walk_to_pt')
   # }
   
+
+  
+  # find individual age / gender distances:
+  trips_age_gender <- trip_scen_sets %>%
+    group_by (age_cat,sex,stage_mode, scenario) %>%
+    summarise(dist_age = sum(stage_distance))
+  
+  # find total trip distances by mode and scenario
+  trips_scen_mode <- trip_scen_sets %>%
+    group_by (stage_mode, scenario) %>%
+    summarise(dist_synth = sum(stage_distance))
+
+  trips_age_gender <- left_join(trips_age_gender, trips_scen_mode, by = c('stage_mode', 'scenario'))
+  
+  # find proportion of total trip distance in each age and gender category
+  trips_age_gender$prop <- trips_age_gender$dist_age / trips_age_gender$dist_synth
+  
+  # find total distance across entire population (and not just synthetic pop)
+  trips_age_gender$tot_dist <- trips_age_gender$dist_synth / total_synth_pop * sum(pop$population)
+  
+  # scale total distance by trip proportion for each age and gender
+  trips_age_gender$tot_dist <- trips_age_gender$tot_dist * trips_age_gender$prop
+ 
+  
+  journeys <- trips_age_gender %>% dplyr::select(-c(dist_age, dist_synth, prop))
+  
+  
   # Add true_dist to the ithim_object
   ithim_object$true_dist <- dist
   
+  #dist2 <- journeys %>% group_by(stage_mode, scenario) %>% summarise(total_dist = sum(tot_dist))
+  
   # distances for injuries calculation
   ithim_object$inj_distances <- distances_for_injury_function(journeys = journeys, dist = dist)
   return(ithim_object)