rm(list=ls())
library(tidyverse)
library(sf)
library(janitor)
library(abjutils)
library(readxl)
sf_parana <- st_read(
"C:\\Users\\rauld\\Google Drive\\Diamantina2018\\Git_Diamantina2018\\shp\\pr\\41MUE250GC_SIR.shp",
quiet = TRUE) %>%
transmute(municipio = as.character(NM_MUNICIP),
cod_ibge = as.integer(paste0(CD_GEOCMU))) %>%
clean_names() %>%
arrange(municipio) %>%
glimpse()
## Observations: 399
## Variables: 3
## $ municipio <chr> "ABATIÁ", "ADRIANÓPOLIS", "AGUDOS DO SUL", "ALMIRANT...
## $ cod_ibge <int> 4100103, 4100202, 4100301, 4100400, 4100459, 4128625...
## $ geometry <simple_feature> POLYGON ((-50.234761969 -23..., POLYGON (...
Descrição: Número de mamógrafos existentes, em uso e disponíveis pelo SUS.
Período: maio/2017
Fonte: TABNET/CNES
mamografos_parana <- read_excel("mamografos_parana.xlsx") %>%
mutate(cod_munici = str_sub(municipio, start = 1L, end = 6L),
munic = str_sub(municipio, start = 8L)) %>%
mutate_if(is.character, funs(toupper)) %>%
select(-c(1)) %>%
rename(municipio = munic,
disponiveis_sus = disponiveis) %>%
glimpse()
## Observations: 399
## Variables: 5
## $ existentes <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0...
## $ em_uso <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0...
## $ disponiveis_sus <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0...
## $ cod_munici <chr> "410010", "410020", "410030", "410040", "41004...
## $ municipio <chr> "ABATIÁ", "ADRIANÓPOLIS", "AGUDOS DO SUL", "AL...
Descrição: Estimativas de 1992 a 2016 utilizadas pelo TCU para determinação das cotas do FPM (sem sexo e faixa etária)
Período: 2015
Fonte: TABNET/Demográficas e Sócioeconômicas
populacao_parana <- read_excel("populacao_estimada_2015.xlsx") %>%
clean_names() %>%
set_names(rm_accent) %>%
arrange(municipio) %>%
mutate(cod_munici = str_sub(municipio, start = 1L, end = 6L),
munic = str_sub(municipio, start = 8L)) %>%
mutate_if(is.character, funs(toupper)) %>%
select(-c(1)) %>%
rename(municipio = munic) %>%
glimpse()
## Observations: 399
## Variables: 3
## $ populacao_estimada <dbl> 7823, 6333, 8983, 112870, 3341, 21744, 1451...
## $ cod_munici <chr> "410010", "410020", "410030", "410040", "41...
## $ municipio <chr> "ABATIÁ", "ADRIANÓPOLIS", "AGUDOS DO SUL", ...
sf_parana <- inner_join(mamografos_parana, sf_parana, by = "municipio") %>%
inner_join(., populacao_parana, by = "municipio") %>%
select(cod_ibge, municipio, geometry, populacao_estimada, existentes, em_uso, disponiveis_sus) %>%
# mutate(taxa = (existentes/populacao_estimada)*1000) %>%
glimpse()
## Observations: 399
## Variables: 7
## $ cod_ibge <int> 4100103, 4100202, 4100301, 4100400, 4100459...
## $ municipio <chr> "ABATIÁ", "ADRIANÓPOLIS", "AGUDOS DO SUL", ...
## $ geometry <simple_feature> POLYGON ((-50.234761969 -23..., ...
## $ populacao_estimada <dbl> 7823, 6333, 8983, 112870, 3341, 3077, 14518...
## $ existentes <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0...
## $ em_uso <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0...
## $ disponiveis_sus <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0...
# Um mapa para cada variável
sf_existentes <- sf_parana %>% mutate(taxa = (existentes/populacao_estimada)*1000) %>% select(-c(6,7))
sf_em_uso <- sf_parana %>% mutate(taxa = (em_uso/populacao_estimada)*1000) %>% select(-c(5,7))
sf_disponiveis_sus <- sf_parana %>% mutate(taxa = (disponiveis_sus/populacao_estimada)*1000) %>% select(-c(5,6))
sf_rede_privada <- sf_parana %>% mutate(taxa = ((em_uso - disponiveis_sus)/populacao_estimada)*1000) %>% select(-c(5,6,7))
# As variáveis são salvas em uma lista com as informações do mapa
mapas <- list(sf_existentes,
sf_em_uso,
sf_disponiveis_sus,
sf_rede_privada)
# Um título para cada gráfico
titulos <- c("Existentes",
"Em uso",
"Disponíveis pelo SUS",
"Rede privada")
O gráfico gerado contém uma escala contínua default que não é razoável, pois não leva em consideração o excessivo número de zeros.
# gera os gráficos
graficos <- map2(mapas, titulos, ~{
ggplot(.x, aes(fill=taxa)) + # cria o ggplot
geom_sf() + # desenha o mapa
ggtitle(.y) + # adiciona o título
theme(plot.title = element_text(size = 12, hjust =.5),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.line.x = element_blank(),
axis.line.y = element_blank(),
panel.background = element_blank(),
panel.grid = element_blank(),
panel.grid.major = element_line(colour = "white"),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.ticks = element_blank(),
legend.position = "bottom") +
# this is the main part
scale_fill_viridis_c(option = "magma",
direction = -1,
name = "Taxa de mamógrafos por 1000 habitantes",
# here we use guide_colourbar because it is still a continuous scale
guide = guide_colorbar(direction = "horizontal",
barheight = unit( 2, units = "mm"),
barwidth = unit(50, units = "mm"),
draw.ulim = F,
title.position = 'top',
# some shifting around
title.hjust = 0.5,
label.hjust = 0.5)
)
# scale_fill_distiller(type = "div", palette = "RdYlBu")
})
Utilizamos o ggpubr::ggarrange para enquadrar as localidades.
library(ggpubr)
ggarrange(graficos[[1]], #existentes
graficos[[2]], #eu_uso
graficos[[3]], #disponível_sus
graficos[[4]], #rede_privada
# colunas, linhas, alinhamento e legenda
ncol = 2,
nrow = 2,
align = "hv",
legend = "bottom",
common.legend = TRUE) %>%
annotate_figure(.,
# Configurando o quadro:
top = text_grob("Taxas de mamógrafos por 1000 habitantes - Municípios do estado Paraná",
color = "black",
vjust = .5,
size = 10,
family = "Times",
just = "center"),
bottom = NA,
left = NA,
right = NA,
fig.lab = NA,
fig.lab.face = NA)
foreign::write.dbf