R/PolyHosp.R

## define a PolyHosp object

#' R6 Class representing a set of Parameters
#' 
#' Parameters contains all the parameters related to the population and the epidemic
#' @importFrom R6 R6Class
#' @importFrom ggvoronoi voronoi_polygon
#' @import leaflet
#' @importFrom sp SpatialPointsDataFrame over SpatialPolygonsDataFrame
#' @importFrom maptools unionSpatialPolygons
#' @docType class
#' @export
#' @keywords population
#' @return Object of \code{\link{R6Class}} with all the population data.
#' @format \code{\link{R6Class}} object.
#' @examples
#' pop = PolyHosp$new()
PolyHosp <- R6::R6Class("PolyHosp",
  public = list(
    #' @field nage number of age groups
    nage = 0,
    #' @field vorHBase hospital database containing all hospital information
    vorHBase = NULL,
    #' @field vorPolyHosp the voronoi polygons
    vorPolyHosp = NULL,
    #' @field vorPolyRegion the voronoi polygons
    vorPolyRegion = NULL,
    #' @field vorPopFiness the population inside each polygons
    vorPopFiness = NULL,
    #' @field vorPopRegion the population inside each Region
    vorPopRegion = NULL,
    #' @description
    #' Create a new `PolyHosp` object.
    #' @param hospitals list of hospitals on which we build the voronoi diagram
    #' @return A new `PolyHosp` object.
    initialize = function(hospitals = NULL){
      if (is.null(hospitals)) hospitals = hospCovid
      #merge the hospital list with the data
      self$vorHBase = merge(hospitals, info_etab, 
                     by.x = "FINESS_GEO", 
                     by.y = "finess_ET", 
                     all.x = TRUE, 
                     all.y = FALSE)
      
      self$vorHBase = self$vorHBase[!(is.na(FINESS_GEO) | is.na(finess_EJ) | is.na(lat))]
      
      self$vorPolyHosp = ggvoronoi::voronoi_polygon(self$vorHBase, x = "lng", y = "lat", outline = outlineFr)
      
      #create a region database for the region polygons
      region_data = self$vorHBase[,lapply(.SD, sum, na.rm = TRUE), .SDcols = 14:53, by = "Region"]
      #merge tessels by region 
      self$vorPolyRegion = sp::SpatialPolygonsDataFrame(
        unionSpatialPolygons(self$vorPolyHosp, self$vorHBase$Region), 
        data = region_data, 
        match.ID = "Region")

      #now we build the population inside each polygons
      #and within the regions
      private$build_voronoi_pop(self$vorPolyHosp)
    }, 
    
    #' @description 
    #' get the leaflet map
    #' @return a leaflet map with the polygons
    getMap = function(){
      map = self$vorPolyHosp %>%
        leaflet() %>%
        addTiles() %>%
        addPolylines() %>%
        addCircleMarkers(lng = ~lng, 
                         lat = ~lat, 
                         opacity = 0.8, 
                         radius = 2, 
                         color = "red",
                         popup = ~ paste(
                           RS,
                           "<br>",
                           FINESS_GEO,
                           "<br>",
                           "Region:",
                           Region)
                         )
      return(map)
    }, 
    
    #' @description 
    #' get the population from a specific polygon by Finess
    #' @param finess the finess of the specific polygon
    getPopFiness = function(finess){
      if (!any(self$vorPopFiness[,FINESS_Voronoi == finess]))
        stop("finess not found !")
      return(self$vorPopFiness[FINESS_Voronoi == finess])
    },
    #' @description 
    #' get the population from a specific Region by name
    #' @param region the finess of the specific polygon
    getPopRegion = function(region){
      if (!any(self$vorPopRegion[,Region == region]))
        stop("Region not found !")
      return(self$vorPopRegion[Region == region])
    }
  ),
  private = list(
    #build the population for each polygon (FINESS) and Region
    build_voronoi_pop = function(vorPolyHosp) {
      # Identification of the towns in each Voronoi polygon #
      data_towns <- copy(population_contact)
      towns <- SpatialPointsDataFrame(data_towns[,.(lng,lat)], 
                                      data = data_towns)
      data_towns[, c("FINESS_Voronoi","Region") := over(towns, vorPolyHosp)[, c("FINESS_GEO","Region")]]
      
      # Compute the population per age per Voronoi polygon #
      self$vorPopFiness <- data_towns[, lapply(.SD, sum),
                                .SDcols = grep("^AGE", names(data_towns)),
                                by = c("FINESS_Voronoi")]
      # Compute the population per age per Region #
      self$vorPopRegion <- data_towns[, lapply(.SD, sum),
                                .SDcols = grep("^AGE", names(data_towns)),
                                by = c("Region")]
    },
    # finess_to_merge : vector of tessels' FINESS to be merged
    voronoi_tessel_merge = function(vorPolyHosp, finess_to_merge, name_merge) {
      # Creation of a vector of IDs #
      original_data <- as.data.table(vorPolyHosp@data)
      original_data[, ID := .I]
      vec_ids <- original_data[, ID]
      # Identification of the tessels to unite in the SpatialPolygonDataframe #
      index <- which(original_data[,FINESS_GEO] %in% finess_to_merge)
      new_index <- max(vec_ids) + 1
      vec_ids[index] <- new_index
      # Update of the data frame #
      new_data <- original_data[-index,]
      modified_data <- original_data[index,
                                     lapply(.SD, sum),
                                     .SDcols = c(grep("LIT", names(original_data)),
                                                 grep("SEJHC", names(original_data)),
                                                 grep("JOU", names(original_data)),
                                                 grep("PLA", names(original_data)),
                                                 grep("SEJHP", names(original_data)))]
      modified_data <- cbind(modified_data, 
                             t(spatial.median(original_data[index,c("lat","lng")])))
      modified_data[, ":=" ("Libelle" = name_merge,
                            "ID" = new_index,
                            "FINESS_GEO" = new_index)]
      
      # Merge the tessels #
      new_vorPolyHosp <- sp::SpatialPolygonsDataFrame(unionSpatialPolygons(vorPolyHosp, vec_ids),
                                                  data = rbind(new_data, 
                                                               modified_data,
                                                               fill = TRUE),
                                                  match.ID = "ID")
      
      return(new_vorPolyHosp)
    },
    voronoi_region_merge = function(vorPolyHosp) {
      
      vorPolyReg = copy(vorPolyHosp)
      ## get list of Region
      listRegions = unique(vorPolyReg@data$Region)
      
      original_data <- as.data.table(vorPolyReg@data)
      original_data[, ID := .I]
      vec_ids <- original_data[, ID]
      
      for (reg in listRegions) {
        # Identification of the tessels to unite in the SpatialPolygonDataframe #
        index <- which(original_data[,Region] == reg)
        new_index <- max(vec_ids) + 1
        vec_ids[index] <- new_index
        # Update of the data frame #
        new_data <- original_data[-index,]
        modified_data <- original_data[index,
                                       lapply(.SD, sum),
                                       .SDcols = c(grep("LIT", names(original_data)),
                                                   grep("SEJHC", names(original_data)),
                                                   grep("JOU", names(original_data)),
                                                   grep("PLA", names(original_data)),
                                                   grep("SEJHP", names(original_data)))]
        modified_data <- cbind(modified_data, 
                               original_data[index,.(lat = mean(lat), lng = mean(lng))]
                               )
        modified_data[, ":="("Libelle" = reg,
                              "ID" = new_index,
                              "FINESS_GEO" = new_index)]
        
        original_data = rbind(new_data, modified_data, fill = TRUE)
        # Merge the tessels #
        vorPolyReg <- sp::SpatialPolygonsDataFrame(unionSpatialPolygons(vorPolyReg, vec_ids),
                                                    data = original_data,
                                                    match.ID = "ID")
        
      }
      return(vorPolyReg)
    }
  )
)
    
PascalCrepey/HospiCoV documentation built on April 11, 2020, 3:13 p.m.