/R/scripts/build_nonUS_setup.R

https://github.com/HopkinsIDD/COVIDScenarioPipeline · R · 120 lines · 68 code · 21 blank · 31 comment · 11 complexity · cb8205917cb05c1f4d7ffba1bda74cf7 MD5 · raw file

  1. ##
  2. # @file
  3. # @brief Creates mobility and geodata for non-US location
  4. #
  5. # @details
  6. #
  7. # ## Configuration Items
  8. #
  9. # ```yaml
  10. # spatial_setup:
  11. # base_path: <path to directory>
  12. # modeled_states: <list of country ISO3 codes> e.g. ZMB, BGD, CAN
  13. # mobility: <path to file relative to base_path> optional; default is 'mobility.csv'
  14. # geodata: <path to file relative to base_path> optional; default is 'geodata.csv'
  15. # popnodes: <string> optional; default is 'pop'
  16. #
  17. #
  18. # ## Input Data
  19. #
  20. # None
  21. #
  22. # ## Output Data
  23. #
  24. # * {spatial_setup::base_path}/{spatial_setup::mobility}
  25. # * {spatial_setup::base_path}/{spatial_setup::geodata}
  26. #
  27. ## @cond
  28. library(dplyr)
  29. library(tidyr)
  30. option_list = list(
  31. optparse::make_option(c("-c", "--config"), action="store", default="config.yml", type='character', help="path to the config file"),
  32. optparse::make_option(c("-w", "--wide_form"), action="store",default=FALSE,type='logical',help="Whether to generate the old wide format mobility or the new long format"),
  33. optparse::make_option(c("-n", "--population"), action="store",default="population_data.csv",type='character',help="Name of the popultion data file"),
  34. optparse::make_option(c("-m", "--mobility"), action="store",default="mobility_data.csv",type='character',help="Name of the mobility data file")
  35. )
  36. opt = optparse::parse_args(optparse::OptionParser(option_list=option_list))
  37. config <- covidcommon::load_config(opt$config)
  38. if (length(config) == 0) {
  39. stop("no configuration found -- please set CONFIG_PATH environment variable or use the -c command flag")
  40. }
  41. outdir <- config$spatial_setup$base_path
  42. filterADMIN0 <- config$spatial_setup$modeled_states
  43. dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
  44. # Read in needed data
  45. commute_data <- readr::read_csv(file.path(config$spatial_setup$base_path, "geodata", opt$mobility)) %>%
  46. mutate(OGEOID = as.character(OGEOID),
  47. DGEOID = as.character(DGEOID))
  48. census_data <- readr::read_csv(file.path(config$spatial_setup$base_path, "geodata", opt$population)) %>%
  49. mutate(GEOID = as.character(GEOID))
  50. # Filter if needed
  51. if (!(is.null(filterADMIN0) || is.na(filterADMIN0))){
  52. census_data <- census_data %>%
  53. dplyr::filter(ADMIN0 %in% filterADMIN0)
  54. }
  55. census_data <- census_data %>%
  56. dplyr::select(ADMIN0,GEOID,ADMIN2,POP) %>%
  57. dplyr::group_by(GEOID,ADMIN2) %>%
  58. dplyr::summarize(ADMIN0 = unique(ADMIN0), POP = sum(POP)) %>%
  59. dplyr::arrange(POP)
  60. commute_data <- commute_data %>%
  61. dplyr::filter(OGEOID %in% census_data$GEOID, DGEOID %in% census_data$GEOID) %>%
  62. dplyr::group_by(OGEOID, DGEOID) %>%
  63. dplyr::summarize(FLOW = sum(FLOW)) %>%
  64. dplyr::filter(OGEOID != DGEOID)
  65. padding_table <- tibble::tibble(
  66. OGEOID = census_data$GEOID,
  67. DGEOID = census_data$GEOID,
  68. FLOW = 0
  69. )
  70. t_commute_table <- tibble::tibble(
  71. OGEOID = commute_data$DGEOID,
  72. DGEOID = commute_data$OGEOID,
  73. FLOW = commute_data$FLOW
  74. )
  75. rc <- padding_table %>%
  76. dplyr::bind_rows(commute_data) %>%
  77. dplyr::bind_rows(t_commute_table)
  78. # Make wide if specified
  79. if(opt$w){
  80. rc <- rc %>% tidyr::pivot_wider(OGEOID, names_from=DGEOID, values_from=FLOW, values_fill=c("FLOW"=0), values_fn = list(FLOW=sum))
  81. }
  82. if(opt$w){
  83. if(!isTRUE(all(rc$OGEOID == census_data$GEOID))){
  84. stop("There was a problem generating the mobility matrix")
  85. }
  86. write.table(file = file.path(outdir,'mobility.txt'), as.matrix(rc[,-1]), row.names=FALSE, col.names = FALSE, sep = " ")
  87. } else {
  88. names(rc) <- c("ori","dest","amount")
  89. rc <- rc[rc$ori != rc$dest,]
  90. write.csv(file = file.path(outdir,'mobility.csv'), rc, row.names=FALSE)
  91. }
  92. # Save population geodata
  93. names(census_data) <- c("geoid","admin2","admin0","pop")
  94. write.csv(file = file.path(outdir,'geodata.csv'), census_data,row.names=FALSE)
  95. print("Census Data Check (up to 6 rows)")
  96. print(head(census_data))
  97. print("Commute Data Check (up to 6 rows)")
  98. print(head(commute_data))
  99. print(paste0("mobility.csv/.txt and geodata.csv saved to: ", outdir))