HOT: The Health-Oriented Transportation (HOT) Model

#' Map a TS object with corresponding GIS file by a given HOT metric
#' 
#' This function takes a TravelSurvey object, a corresponding GIS file, and a HOT metric to calculate and of which plots a neatly organized map stratified by location
#' 
#' @param ts TravelSurvey object
#' @param GIS.df Dataframe of GIS data corresponding to TS object, containing location column that matches
#' @param metric HOT metric used for analysis. Options available: participation, frequency, proportion, intensity, duration, trips, CRA
#' @param mode Required if HOT metric is stratified by mode of transit. Options available: walk, cycle, other
#' @param scenario Required if HOT metric is stratified by participation scenario. Options available: rho.s.1, rho.s.2
#' @param author Required if HOT metric is stratified by participation scenario. Options available: Arem, Lear, Wen
#' @param income Required if HOT metric is stratified by participation scenario. Options available: HIgh, Upper-middle, Lower-middle, Low
#' @param interactive Boolean deterining whether returned plot is interactive (ggplotly object) or not (ggplot object). Default value is TRUE
#' 
#' @return Interactive map
#' @export
plotMap <- function(ts, GIS.df, metric, mode = NULL, scenario = NULL, author = NULL, income = NULL, interactive  = TRUE){

  # include checks to make sure ts and GIS.df match? Or do that outside of this function?
  # write these at the end, and move to class definition if we go that route
  
  # Perform analysis of given metric, return results to usable dataframe
  data.df <- getHOT(ts, metric, mode, scenario, author, income)
  
  # Join result dataframe with GIS.df
  map.df <- left_join(GIS.df, data.df, by = "location")
  
  # Generate plot of data
  getMap(map.df, metric, mode, scenario, author, income, interactive)
}
#' Calculate HOT metric results for given TS object
#' 
#' This function takes a TravelSurvey object, a HOT metric to calculate, and any additional variables to feed into that metric calculation
#' 
#' @param ts TravelSurvey object
#' @param metric HOT metric used for analysis. Options available: participation, frequency, proportion, intensity, duration, trips, CRA
#' @param mode Required if HOT metric is stratified by mode of transit. Options available: walk, cycle, other
#' @param scenario Required if HOT metric is stratified by participation scenario. Options available: rho.s.1, rho.s.2
#' @param author Required if HOT metric is stratified by participation scenario. Options available: Arem, Lear, Wen
#' @param income Required if HOT metric is stratified by participation scenario. Options available: High, Upper-middle, Lower-middle, Low
#' 
#' @return Results dataframe stratified by location
#' @export
getHOT <- function(ts, metric, mode = NULL, scenario = NULL, author = NULL, income = NULL){
  
  # Consider given metric, perform corresponding analysis
  switch(metric,
         "participation" = { results <- getParticipation(ts) },
         "frequency" = { results <- getFrequency(ts) },
         "proportion" = { results <- getProportion(ts) },
         "intensity" = { results <- getIntensity(ts) %>% rename(intensity = mean) %>% select(location, intensity) },
         "duration" = { switch(mode,
                               "walk" = { results <- getMeans(ts, activeTravelers = FALSE) %>% select(location, walk) },
                               "cycle" = { results <- getMeans(ts, activeTravelers = FALSE) %>% select(location, cycle) },
                               "other" = { results <- getMeans(ts, activeTravelers = FALSE) %>% select(location, other) }) },
         "trips" = { switch(mode,
                            "walk" = { results <- getTrips(ts) %>% select(location, walk) },
                            "cycle" = { results <- getTrips(ts) %>% select(location, cycle) },
                            "other" = { results <- getTrips(ts) %>% select(location, other) }) },
         "CRA" = { if( author == "Lear"){ results <- CRA.ts(ts) %>% dplyr::filter(scenario == scenario & author == author & income == income) 
           }else{ results <- CRA.ts(ts) %>% dplyr::filter(scenario == scenario & author == author) } })
  
  return(results)
}
#' Plot an interactive map of TS, GIS, and metric
#' 
#' This function takes a dataframe of merged HOT metric data with corresponding GIS and plots the resulting map
#' 
#' @param map.df A merged dataframe of TS metric results and corresponding GIS data
#' @param metric HOT metric used for analysis. Options available: participation, frequency, proportion, intensity, duration, trips, CRA
#' @param mode Required if HOT metric is stratified by mode of transit. Options available: walk, cycle, other
#' @param scenario Required if HOT metric is stratified by participation scenario. Options available: rho.s.1, rho.s.2
#' @param author Required if HOT metric is stratified by participation scenario. Options available: Arem, Lear, Wen
#' @param income Required if HOT metric is stratified by participation scenario. Options available: High, Upper-middle, Lower-middle, Low
#' @param interactive Boolean deterining whether returned plot is interactive (ggplotly object) or not (ggplot object). Default value is TRUE
#' 
#' @return Interactive map
#' @export
getMap <- function(map.df, metric, mode = NULL, scenario = NULL, author = NULL, income = NULL, interactive = TRUE){
  
  # Set variable 'aesHOT' to metric-specific ggplot2::aes() configuration, set variable 'variable' to value ultimately plotted
  if( metric %in% c("duration", "trips") & !is.null(mode) ){ aesHOT <- aes(x = long, y = lat, group = group, fill = get(mode)); valueMeasured <- mode # duration, trips
  }else if( metric == "CRA" & !is.null(scenario) ){ aesHOT <- aes(x = long, y = lat, group = group, fill = get(scenario)); valueMeasured <- scenario # CRA
  }else{ aesHOT <- aes(x = long, y = lat, group = group, fill = get(metric)); valueMeasured <- metric } # participation, frequency, proportion, intensity
  
  # Set variable 'labsHOT' to metric-specific ggplot2::labs() configuration
  if( metric %in% c("duration", "trips") & !is.null(mode) ){ labsHOT <- labs(title = paste("Map of", mode, metric, "by location"), fill = metric) # duration, trips
  }else if( metric == "CRA" & !is.null(scenario) ){ # CRA
    switch(scenario,
           "rho.s.1" = { labsHOT <- labs(title = paste("Map of risk (CRA) by location, zero participation (Scenario 1)"), fill = paste("Population Attributable Fraction --", author, income)) },
           "rho.s.2" = { labsHOT <- labs(title = paste("Map of risk (CRA) by location, full participation (Scenario 2)"), fill = paste("Population Attributable Fraction --", author, income)) })
  }else{ labsHOT <- labs(title = paste("Map of", metric, "by location"), fill = metric) } # participation, frequency, proportion, intensity
  
  # Create generalized ggplot object
  minval <- min(map.df[valueMeasured], na.rm = TRUE) # min value, for use in plot
  maxval <- max(map.df[valueMeasured], na.rm = TRUE) # max value, for use in plot
  map.df <- map.df %>% # ggplot specifications
    ggplot() +
    aesHOT + # see code above
    geom_polygon() +  
    geom_path(color = "white", size = 0.2) +
    scale_fill_gradient(low = "#0000FF", high = "#FF0000", breaks = c(round(seq(minval, maxval, (maxval - minval)/4), 3))) +
    labsHOT + # see code above
    theme(axis.title.x = element_blank(), axis.title.y = element_blank(),
          axis.text.x = element_blank(), axis.text.y = element_blank(),
          axis.ticks.x = element_blank(), axis.ticks.y = element_blank())
  
  # If interactive map is desired (default), return ggplotly object. Otherwise, return ggplot object
  if( interactive ){ map.df <- plotly::ggplotly(map.df, tooltip = c("location", map.df[valueMeasured])) %>% plotly::config(displayModeBar = F) }
  
  # Return plot
  return(map.df)
}
#' Map a TS object with corresponding GIS file by a given HOT metric, stratified by year
#' 
#' This function takes a TravelSurvey object, a corresponding GIS file, and a HOT metric to calculate and of which plots a neatly organized map stratified by location and year
#' 
#' @param ts TravelSurvey object
#' @param GIS.df Dataframe of GIS data corresponding to TS object, containing location column that matches
#' @param metric HOT metric used for analysis. Options available: participation, frequency, proportion, intensity, duration, trips, CRA
#' @param mode Required if HOT metric is stratified by mode of transit. Options available: walk, cycle, other
#' @param scenario Required if HOT metric is stratified by participation scenario. Options available: rho.s.1, rho.s.2
#' @param author Required if HOT metric is stratified by participation scenario. Options available: Arem, Lear, Wen
#' @param income Required if HOT metric is stratified by participation scenario. Options available: HIgh, Upper-middle, Lower-middle, Low
#' @param interactive Boolean deterining whether returned plot is interactive (ggplotly object) or not (ggplot object). Default value is TRUE
#' 
#' @return Interactive map with slider for examining over-time data (by year)
#' @export
plotMapByYear <- function(ts, GIS.df, metric, mode = NULL, scenario = NULL, author = NULL, income = NULL){
  
  # include checks to make sure ts and GIS.df match? Or do that outside of this function?
  # write these at the end, and move to class definition if we go that route
  
  # Perform analysis of given metric, return results to usable dataframe with associated year column
  data.df <- getHOTByYear(ts, metric, mode, scenario, author, income)
  
  # Join result dataframe with GIS.df
  switch(metric,
         "duration" = { valueMeasured <- mode },
         "trips" = { valueMeasured <- mode },
         "CRA" = { valueMeasured <- scenario },
         { valueMeasured <- metric }) # participation, frequency, proportion, intensity
  map.df <- left_join(GIS.df, data.df, by = "location") %>% select(long, lat, location, valueMeasured, year)
  
  # Generate plot of data
  getMapByYear(map.df, metric, mode, scenario, author, income)
}
#' Calculate HOT metric results for given TS object, stratified by year
#' 
#' This function takes a TravelSurvey object, a HOT metric to calculate, and any additional variables to feed into that metric calculation and returns results by year
#' 
#' @param ts TravelSurvey object
#' @param metric HOT metric used for analysis. Options available: participation, frequency, proportion, intensity, duration, trips, CRA
#' @param mode Required if HOT metric is stratified by mode of transit. Options available: walk, cycle, other
#' @param scenario Required if HOT metric is stratified by participation scenario. Options available: rho.s.1, rho.s.2
#' @param author Required if HOT metric is stratified by participation scenario. Options available: Arem, Lear, Wen
#' @param income Required if HOT metric is stratified by participation scenario. Options available: High, Upper-middle, Lower-middle, Low
#' 
#' @return Results dataframe stratified by location and year
#' @export
getHOTByYear <- function(ts, metric, mode = NULL, scenario = NULL, author = NULL, income = NULL){
  
  # Initialize results df
  results <- data.frame()
  
  # Loop through all years, calculating 
  years <- unique(ts@house$year)
  for(i in years){
    
    # Subset ts by iterated year
    temp.ts <- ts[i]
    
    # Generate HOT metric results
    data.df <- getHOT(temp.ts, metric, mode, scenario, author, income) %>% mutate(year = 2000 + as.numeric(i)) # This last command is London-specific and will need to be changed/removed
    
    # Merge into combined results df
    results <- rbind(results, data.df)
  }
  
  # Return results
  return(results)
}
#' Plot an interactive map of TS, GIS, and metric stratified by year (via slider)
#' 
#' This function takes a dataframe of merged HOT metric data with corresponding GIS and plots the resulting map, stratified by year (via slider)
#' 
#' @param map.df A merged dataframe of TS metric results and corresponding GIS data
#' @param metric HOT metric used for analysis. Options available: participation, frequency, proportion, intensity, duration, trips, CRA
#' @param mode Required if HOT metric is stratified by mode of transit. Options available: walk, cycle, other
#' @param scenario Required if HOT metric is stratified by participation scenario. Options available: rho.s.1, rho.s.2
#' @param author Required if HOT metric is stratified by participation scenario. Options available: Arem, Lear, Wen
#' @param income Required if HOT metric is stratified by participation scenario. Options available: High, Upper-middle, Lower-middle, Low
#' @param interactive Boolean deterining whether returned plot is interactive (ggplotly object) or not (ggplot object). Default value is TRUE
#' 
#' @return Interactive map with slider for examining over-time data (by year)
#' @export
getMapByYear <- function(map.df, metric, mode = NULL, scenario = NULL, author = NULL, income = NULL){
  
  # Set variable 'aesHOT' to metric-specific ggplot2::aes() configuration, set variable 'valueMeasured' to value ultimately plotted
  if( metric %in% c("duration", "trips") & !is.null(mode) ){ aesHOT <- aes(x = long, y = lat, group = group, fill = get(mode)); valueMeasured <- mode # duration, trips
  }else if( metric == "CRA" & !is.null(scenario) ){ aesHOT <- aes(x = long, y = lat, group = group, fill = get(scenario)); valueMeasured <- scenario # CRA
  }else{ aesHOT <- aes(x = long, y = lat, group = group, fill = get(metric)); valueMeasured <- metric } # participation, frequency, proportion, intensity
  
  # Set variable 'labsHOT' to metric-specific ggplot2::labs() configuration
  if( metric %in% c("duration", "trips") & !is.null(mode) ){ labsHOT <- labs(title = paste("Map of", mode, metric, "by location"), fill = metric) # duration, trips
  }else if( metric == "CRA" & !is.null(scenario) ){ # CRA
    switch(scenario,
           "rho.s.1" = { labsHOT <- labs(title = paste("Map of risk (CRA) by location, zero participation (Scenario 1)"), fill = paste("Population Attributable Fraction --", author, income)) },
           "rho.s.2" = { labsHOT <- labs(title = paste("Map of risk (CRA) by location, full participation (Scenario 2)"), fill = paste("Population Attributable Fraction --", author, income)) })
  }else{ labsHOT <- labs(title = paste("Map of", metric, "by location"), fill = metric) } # participation, frequency, proportion, intensity
  
  # Generate ggplot object, suppressing benign warning "Warning: Ignoring unknown aesthetics: frame"
  minval <- min(map.df[valueMeasured], na.rm = TRUE) # min value, for use in plot
  maxval <- max(map.df[valueMeasured], na.rm = TRUE) # max value, for use in plot
  map.ggplot <- suppressWarnings(ggplot(map.df, aesHOT) + # ggplot specifications
                                   geom_polygon(aes(frame = year)) +
                                   geom_path(color = "white", size = 0.2) +
                                   scale_fill_gradient(low = "#0000FF", high = "#FF0000", breaks = c(round(seq(minval, maxval, (maxval - minval)/4), 3))) +
                                   labsHOT +
                                   theme(axis.title.x = element_blank(), axis.title.y = element_blank(),
                                         axis.text.x = element_blank(), axis.text.y = element_blank(),
                                         axis.ticks.x = element_blank(), axis.ticks.y = element_blank()))
  
  # Convert to ggplotly for final plot and return object
  map.ggplotly <- plotly::ggplotly(map.ggplot) %>% plotly::animation_opts(frame = 40, transition = 0, easing = "linear") %>% plotly::config(displayModeBar = F) # Known bug: need to fix tooltip
  return(map.ggplotly)
}