update

R/04.5-corrigir_ttmatrix.R

@@ -10,32 +10,46 @@ source('./R/fun/setup.R')
 # que nao tenha menos que 10 hex de acess.
 
 # sigla_muni <- 'spo'; ano <- 2017
-# sigla_muni <- 'poa'; ano <- 2019
+# sigla_muni <- 'poa'; ano <- 2017
 # sigla_muni <- 'bel'; ano <- 2019
+# sigla_muni <- 'bho'; ano <- 2017
 # sigla_muni <- 'nat'; ano <- 2017
-# sigla_muni <- 'man'; ano <- 2019
+# sigla_muni <- 'man'; ano <- 2017
 # sigla_muni <- 'spo'; ano <- 2019
+# sigla_muni <- 'for'; ano <- 2019
 
-identificar_e_corrigir_extremos_acess_muni <- function(sigla_muni, ano) {
+corrigir_ttmatrix <- function(sigla_muni, ano) {
 
  # status message
  message('Woking on city ', sigla_muni, ' at year ', ano)
 
+ ttmatrix_files <- dir(sprintf("E:/data/output_ttmatrix/%s/r5/", ano),
+ full.names = TRUE, pattern = sprintf("ttmatrix_%s_%s_r5", ano, sigla_muni))
+
+ if (length(ttmatrix_files) > 1) {
+
+ ttmatrix_allmodes <- lapply(ttmatrix_files, fread) %>% rbindlist() 
+
+ } else ttmatrix_allmodes <- fread(ttmatrix_files)
 
- ttmatrix_allmodes <- fread(sprintf("E:/data/output_ttmatrix/%s/r5/ttmatrix_%s_%s_r5.csv", 
- ano, ano, sigla_muni))
+
+ # rename columns
+ colnames(ttmatrix_allmodes) <- c("origin", "destination", "travel_time", "mode", "pico", "city","ano")
 
  # pegar so bike
  ttmatrix_teste <- ttmatrix_allmodes[mode == "bike"]
  # ttmatrix_teste <- ttmatrix_allmodes[mode == "transit" & pico == 1]
  # ttmatrix_teste <- ttmatrix_allmodes
 
  # abrir os pontos da resolucao 09 ~~~~
- points_file <- sprintf("../../r5/points/%s/points_%s_09_%s.csv", ano, sigla_muni, ano)
+ points_file <- sprintf("../../data/acesso_oport/r5/points/%s/points_%s_09_%s.csv", ano, sigla_muni, ano)
  # points_file <- "../../data/avaliacao_intervencoes/r5/points/points_for_09_2019.csv"
  points <- fread(points_file)
 
 
+ # 2) make sure we dont have too many points -------------------------------
+ ttmatrix_allmodes <- ttmatrix_allmodes[origin %in% points$id_hex]
+
  # 1) Identificar quais pontos nao foram roteados --------------------
 
  # checar os pontos na matrix ~~~~
@@ -46,6 +60,7 @@ identificar_e_corrigir_extremos_acess_muni <- function(sigla_muni, ano) {
 
  ## quais origens e destinos ficaram fora? ~~~~
  origem_fora <- setdiff(points$id_hex, origem_matrix) 
+ # setdiff(origem_matrix, points$id_hex) 
  destino_fora <- setdiff(points$id_hex, destino_matrix)
 
  # quais pontos ficaram fora completamente? tanto a origem como o destino ~~
@@ -209,8 +224,7 @@ identificar_e_corrigir_extremos_acess_muni <- function(sigla_muni, ano) {
  ttmatrix_hex_fim[mode == "transit", travel_time := fifelse(origin == destination, 5.8, travel_time)]
 
  # salvar output corrigido
- write_rds(ttmatrix_hex_fim, sprintf("E:/data/ttmatrix_fixed/%s/ttmatrix_fixed_%s_%s.rds", ano, ano, sigla_muni),
- compress = "gz")
+ write_rds(ttmatrix_hex_fim, sprintf("E:/data/ttmatrix_fixed/%s/ttmatrix_fixed_%s_%s.rds", ano, ano, sigla_muni))
 
  rm(ttmatrix_allmodes)
  rm(ttmatrix_allmodes_nprob)
@@ -222,27 +236,27 @@ identificar_e_corrigir_extremos_acess_muni <- function(sigla_muni, ano) {
 
 
 # aplicar funcao ------------------------------------------------------------------------------
-plan(multiprocess, workers = 1)
+plan(multiprocess, workers = 2)
 furrr::future_walk(munis_list$munis_metro[ano_metro == 2017]$abrev_muni, 
- identificar_e_corrigir_extremos_acess_muni, ano = 2017)
+ corrigir_ttmatrix, ano = 2017)
 furrr::future_walk(munis_list$munis_metro[ano_metro == 2018]$abrev_muni, 
- identificar_e_corrigir_extremos_acess_muni, ano = 2018)
+ corrigir_ttmatrix, ano = 2018)
 furrr::future_walk(munis_list$munis_metro[ano_metro == 2019]$abrev_muni, 
- identificar_e_corrigir_extremos_acess_muni, ano = 2019)
+ corrigir_ttmatrix, ano = 2019)
 walk(munis_list$munis_metro[ano_metro == 2019]$abrev_muni, 
- identificar_e_corrigir_extremos_acess_muni, ano = 2019)
+ corrigir_ttmatrix, ano = 2019)
 
 
 # falta spo, rio, goi, bsb
 walk(c("for", "cur","poa","bho",
  "sal","man","rec","bel",
  "gua","cam","slz","sgo",
  "mac","duq","cgr", 'nat'),
- identificar_e_corrigir_extremos_acess_muni, ano = 2018)
+ corrigir_ttmatrix, ano = 2018)
 walk(c("rio","goi","bsb"),
- identificar_e_corrigir_extremos_acess_muni, ano = 2019)
+ corrigir_ttmatrix, ano = 2019)
 walk(c("for", "cur","poa","bho",
  "sal","man","rec","bel",
  "gua","cam","slz","sgo",
  "mac","duq","cgr", 'nat'),
- identificar_e_corrigir_extremos_acess_muni, ano = 2019)
+ corrigir_ttmatrix, ano = 2019)

R/04.5-corrigir_ttmatrix_carro.R

@@ -0,0 +1,134 @@
+# carregar bibliotecas
+source('./R/fun/setup.R')
+
+
+# 1) Identificar e corrigir hexagonos que nao foram roteados -----
+
+# Sao identificados hexagos que nao foram roteados pelo streetmap 
+
+# sigla_muni <- 'spo'
+# sigla_muni <- 'poa'
+# sigla_muni <- 'bel'
+# sigla_muni <- 'bho'
+# sigla_muni <- 'nat'
+# sigla_muni <- 'man'
+# sigla_muni <- 'bel'
+# sigla_muni <- 'spo'
+# sigla_muni <- 'for'
+# sigla_muni <- 'goi'
+# sigla_muni <- 'rio'
+# sigla_muni <- 'cgr'
+
+corrigir_ttmatrix <- function(sigla_muni) {
+
+ # status message
+ message('Woking on city ', sigla_muni)
+
+ # abrir matriz original
+ ttmatrix_allmodes <- fread(sprintf("E:/data/output_ttmatrix/car/OD_TI_%s.csv", sigla_muni))
+ ttmatrix_allmodes <- ttmatrix_allmodes %>%
+ dplyr::rename(origin = 1, destination = 2) %>%
+ setDT()
+
+ # abrir matriz extra
+ if (sigla_muni %nin% c('cur', 'goi')) {
+
+ ttmatrix_extra <- fread(sprintf("E:/data/output_ttmatrix/car/OD_TI_%s_extra.csv", sigla_muni))
+ # trazer pontos com ids
+ points_int <- fread(sprintf("../../git_kaue/acesso_oport/R/pontos_extras/ids/ids_%s.csv", sigla_muni))
+ ttmatrix_extra[points_int, on = c("origin_hex" = "id_hex_int"),
+ c("id_hex_origin") :=
+ list(i.id_hex)]
+ ttmatrix_extra[points_int, on = c("destination_hex" = "id_hex_int"),
+ c("id_hex_destination") :=
+ list(i.id_hex)]
+ ttmatrix_extra$origin_hex <- NULL
+ ttmatrix_extra$destination_hex <- NULL
+ ttmatrix_extra <- ttmatrix_extra %>% rename(origin = id_hex_origin, destination = id_hex_destination) %>% setDT()
+
+ # juntar matriz original com matriz extra
+ ttmatrix_allmodes <- rbind(ttmatrix_allmodes, ttmatrix_extra)
+
+ }
+
+
+ # 1) initial setup --------------------------------------------------------
+
+
+ # select only necessary columns
+ ttmatrix_allmodes <- ttmatrix_allmodes[, .(origin, destination,
+ median_morning_peak, median_afternoon_offpeak)]
+ ttmatrix_allmodes[, city := substr(sigla_muni, 1, 3)]
+ ttmatrix_allmodes[, mode := "car"]
+
+ # add parking time
+ ttmatrix_allmodes[origin != destination, median_morning_peak := median_morning_peak + 2]
+ ttmatrix_allmodes[origin != destination, median_afternoon_offpeak := median_afternoon_offpeak + 2]
+
+ # abrir os pontos da resolucao 09 ~~~~
+ points_file <- sprintf("../../data/acesso_oport/r5/points/%s/points_%s_09_%s.csv", c(2017:2019), sigla_muni, c(2017:2019))
+ # points_file <- "../../data/avaliacao_intervencoes/r5/points/points_for_09_2019.csv"
+ points <- lapply(points_file, fread) %>% rbindlist() %>% distinct(id_hex, .keep_all = TRUE) %>% setDT()
+
+
+ # 2) make sure we dont have too many points -------------------------------
+ ttmatrix_allmodes <- ttmatrix_allmodes[origin %in% points$id_hex]
+ ttmatrix_allmodes <- ttmatrix_allmodes[destination %in% points$id_hex]
+
+
+
+
+ # salvar output corrigido ---------------
+
+ # split
+ if (sigla_muni %in% c("bsb", "goi")) {
+
+ # list origins
+ origins <- unique(ttmatrix_allmodes$origin)
+ # divide by 3
+ a <- split(origins, rep_len(1:3, length(origins)))
+ # split ttmatrix
+ fwrite(ttmatrix_allmodes[origin %in% a[[1]]], sprintf("E:/data/ttmatrix_fixed/car/ttmatrix_fixed_%s_%s_origin1.csv", "2019", sigla_muni))
+ fwrite(ttmatrix_allmodes[origin %in% a[[2]]], sprintf("E:/data/ttmatrix_fixed/car/ttmatrix_fixed_%s_%s_origin2.csv", "2019", sigla_muni))
+ fwrite(ttmatrix_allmodes[origin %in% a[[3]]], sprintf("E:/data/ttmatrix_fixed/car/ttmatrix_fixed_%s_%s_origin3.csv", "2019", sigla_muni))
+ # list dests
+ dests <- unique(ttmatrix_allmodes$destination)
+ # divide by 3
+ a <- split(dests, rep_len(1:3, length(dests)))
+ # split ttmatrix
+ fwrite(ttmatrix_allmodes[destination %in% a[[1]]], sprintf("E:/data/ttmatrix_fixed/car/ttmatrix_fixed_%s_%s_dest1.csv", "2019", sigla_muni))
+ fwrite(ttmatrix_allmodes[destination %in% a[[2]]], sprintf("E:/data/ttmatrix_fixed/car/ttmatrix_fixed_%s_%s_dest2.csv", "2019", sigla_muni))
+ fwrite(ttmatrix_allmodes[destination %in% a[[3]]], sprintf("E:/data/ttmatrix_fixed/car/ttmatrix_fixed_%s_%s_dest3.csv", "2019", sigla_muni))
+
+
+ } else {
+
+ setorder(ttmatrix_allmodes, origin)
+
+ fwrite(ttmatrix_allmodes, sprintf("E:/data/ttmatrix_fixed/car/ttmatrix_fixed_%s_%s.csv", "2019", sigla_muni))
+
+ }
+
+ rm(ttmatrix_allmodes)
+ gc(TRUE)
+
+}
+
+
+
+# aplicar funcao ------------------------------------------------------------------------------
+walk(c("for", "cur","poa","bho",
+ "sal","rec","bel",
+ "gua","cam","slz","sgo",
+ "mac","duq", 'nat', 'rio', 'spo'),
+ corrigir_ttmatrix)
+walk(c("rio","goi","bsb", "spo", "cgr","man"),
+ corrigir_ttmatrix)
+
+# corrigir_ttmatrix("rio")
+corrigir_ttmatrix("spo")
+
+# need spliting
+corrigir_ttmatrix("cgr")
+corrigir_ttmatrix("bsb")
+corrigir_ttmatrix("goi")