---
title: "Sífilis Adquirida"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
theme: cosmo
social: menu
source_code: embed
---
```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(plotly)
library(lubridate)
library(readr)
library(janitor)
library(rio)
library(htmltools)
library(foreign)
library(dplyr)
library(ggplot2)
library(forcats)
library(purrr)
library(sf)
library(leaflet)
library(stringr)
library(tibble)
# Projeção pop.
ano_atual <- as.integer(format(Sys.Date(), "%Y"))
ANOS_DISP <- 2020:2030 # faixa da planilha de projeções
# Conectar ao banco de dados
setwd("Z:/")
# Carregando base de dados
adquirida <- import("NINDINET.dbf")
# Ver os nomes das variáveis
names(adquirida)
# Ver as primeiras linhas
head(adquirida)
# Ver estrutura da base
str(adquirida)
# Filtrar casos de sífilis (qualquer tipo)
sifilis <- adquirida %>% filter(ID_AGRAVO %in% c("A539"))
# Definir os critérios
id_bairros <- c(275, 276, 277, 216, 217, 218, 219, 220, 221, 222,
266, 267, 268, 269, 274, 271, 272, 273, 270)
nomes_bairros <- c("PLANALTINA", "SOBRADINHO", "FERCAL", "SOBRADINHO II",
"ARAPOANGAS", "ARAPONGA", "ARAPOANGA")
id_distritos <- c(11, 17, 34, 435, 568)
# Filtrar os dados
dados_filtrados <- sifilis %>%
filter(
(
ID_DISTRIT %in% id_distritos |
(is.na(ID_DISTRIT) | ID_DISTRIT == "") &
(
ID_BAIRRO %in% id_bairros |
(is.na(ID_BAIRRO) | ID_BAIRRO == "") &
grepl(paste(nomes_bairros, collapse = "|"), toupper(NM_BAIRRO))
)
)
)
## Data de nascimento
dados_filtrados <- dados_filtrados %>%
mutate(
DT_NASC = as.Date(DT_NASC), # Garante que é tipo data
idade = as.integer(floor(interval(DT_NASC, Sys.Date()) / years(1))), # Calcula a idade
faixa_etaria = case_when(
idade < 10 ~ "0-9",
idade < 20 ~ "10-19",
idade < 30 ~ "20-29",
idade < 40 ~ "30-39",
idade < 50 ~ "40-49",
idade < 60 ~ "50-59",
idade < 70 ~ "60-69",
idade < 80 ~ "70-79",
idade >= 80 ~ "80+",
TRUE ~ NA_character_
)
)
## Alterado o sexo
dados_filtrados <- dados_filtrados %>%
mutate(CS_SEXO = case_when(
CS_SEXO == "M" ~ "Masculino",
CS_SEXO == "F" ~ "Feminino",
TRUE ~ CS_SEXO # Mantém outros valores, se houver
))
# Contagem
contagem <- dados_filtrados %>%
count(CS_SEXO)
# Indicadores
total_casos <- nrow(dados_filtrados)
num_feminino <- contagem %>% filter(CS_SEXO == "Feminino") %>% pull(n)
num_masculino <- contagem %>% filter(CS_SEXO == "Masculino") %>% pull(n)
# Preparar dados para pirâmide etária
dados_piramide <- dados_filtrados %>%
filter(!is.na(faixa_etaria), !is.na(CS_SEXO)) %>%
count(faixa_etaria, CS_SEXO) %>%
mutate(
# Para o masculino, multiplicar por -1 para ficar do lado esquerdo
n = ifelse(CS_SEXO == "Masculino", -n, n),
faixa_etaria = factor(faixa_etaria, levels = c("0-9","10-19","20-29","30-39","40-49","50-59","60-69","70-79","80+"))
)
## Alterar dados de Raça
dados_filtrados <- dados_filtrados %>%
mutate(CS_RACA = case_when(
CS_RACA == 1 ~ "Branca",
CS_RACA == 2 ~ "Preta",
CS_RACA == 3 ~ "Amarela",
CS_RACA == 4 ~ "Parda",
CS_RACA == 5 ~ "Indígena",
CS_RACA == 9 ~ "Ignorado",
TRUE ~ NA_character_
))
# Garantir que SEM_NOT seja texto
dados_filtrados <- dados_filtrados %>%
mutate(SEM_NOT = as.character(SEM_NOT))
# Contagem por semana epidemiológica
dados_semana <- dados_filtrados %>%
count(SEM_NOT)
## Modificar ID BAirros
dados_filtrados <- dados_filtrados %>%
mutate(ID_BAIRRO = case_when(
ID_BAIRRO == 275 ~ "Área rural Fercal",
ID_BAIRRO == 276 ~ "Fercal",
ID_BAIRRO == 277 ~ "Ignorado Fercal",
ID_BAIRRO == 216 ~ "Arapoangas",
ID_BAIRRO == 217 ~ "Núcleo Rural Arrozal",
ID_BAIRRO == 218 ~ "Condomínio Mestre D'Armas",
ID_BAIRRO == 219 ~ "Planaltina Tradicional",
ID_BAIRRO == 220 ~ "Vale do Amanhecer",
ID_BAIRRO == 221 ~ "Núcleo Rural Monjolo",
ID_BAIRRO == 222 ~ "Ignorado Planaltina",
ID_BAIRRO == 266 ~ "Área rural Sobradinho",
ID_BAIRRO == 267 ~ "Condomínio RK",
ID_BAIRRO == 268 ~ "Nova Colina",
ID_BAIRRO == 269 ~ "Sobradinho",
ID_BAIRRO == 274 ~ "Ignorado Sobradinho",
ID_BAIRRO == 271 ~ "Área rural Sobradinho II",
ID_BAIRRO == 272 ~ "Lago Oeste",
ID_BAIRRO == 273 ~ "Sobradinho II",
is.na(ID_BAIRRO) ~ "Sem informação",
TRUE ~ as.character(ID_BAIRRO)
))
## Adicionar coluna de SE
dados_filtrados <- dados_filtrados %>%
mutate(
ano = str_sub(SEM_NOT, 1, 4),
semana = str_sub(SEM_NOT, 5, 6)
)
## Agrupar Bairros por Região
dados_filtrados <- dados_filtrados %>%
mutate(
regiao = case_when(
ID_BAIRRO %in% c("Área rural Fercal", "Fercal", "Ignorado Fercal") ~ "Fercal",
ID_BAIRRO %in% c("Núcleo Rural Arrozal", "Condomínio Mestre D'Armas", "Planaltina Tradicional",
"Vale do Amanhecer", "Núcleo Rural Monjolo", "Ignorado Planaltina") ~ "Planaltina",
ID_BAIRRO %in% c("Área rural Sobradinho", "Condomínio RK", "Nova Colina", "Sobradinho", "Ignorado Sobradinho") ~ "Sobradinho",
ID_BAIRRO %in% c("Área rural Sobradinho II", "Lago Oeste", "Sobradinho II") ~ "Sobradinho II",
ID_BAIRRO %in% c("Arapoangas") ~ "Arapoangas",
TRUE ~ "Sem região"
)
)
## Dados de 2025 de acordo com o Bairro
dados_bairro_ano <- dados_filtrados %>%
filter(ano == "2025") %>%
count(ID_BAIRRO, regiao) %>%
arrange(desc(n))
# Projeção da pop
path_pop <- "X:/NVEPI - DIRAPS/POPULAÇÃO/Projeções-Populacionais-Estruturas-Etárias-por-RA-2020-2030.xlsx"
RAs_ALVO <- c("Planaltina","Sobradinho","Sobradinho II","Fercal")
# localiza coluna do ano na folha e retorna o TOTAL
pop_total_por_ano <- function(sheet, ano){
ano <- as.integer(ano)
ano <- min(max(ano, 2020), 2030) # clamp 2020–2030
df <- readxl::read_excel(path_pop, sheet = sheet, col_names = FALSE)
# acha linha "Idade" (onde estão os anos no cabeçalho “espalhado” nas colunas)
idx_head <- which(apply(df, 1, function(r) any(str_detect(as.character(r), "^Idade$"), na.rm = TRUE)))[1]
header <- df[idx_head, , drop = TRUE]
# colunas que têm anos numéricos
anos_cols <- which(suppressWarnings(!is.na(as.integer(as.character(header)))))
anos_vals <- as.integer(as.character(unlist(header[anos_cols])))
# linha "Total" (primeira coluna literalmente “Total”)
idx_total <- which(sapply(seq_len(nrow(df)), function(i){
v <- df[i, 1, drop=TRUE]
is.character(v) && str_trim(v) == "Total"
}))[1]
if (is.na(idx_total)) return(NA_real_)
if (!(ano %in% anos_vals)) return(NA_real_)
col_ano <- anos_cols[which(anos_vals == ano)]
as.numeric(df[idx_total, col_ano, drop=TRUE])
}
# tabela de denominadores para o ano escolhido
get_denominadores_ra <- function(ano){
pop <- tibble(
regiao = RAs_ALVO,
populacao = map_dbl(RAs_ALVO, ~pop_total_por_ano(.x, ano))
)
pop
}
# escolha do ano (use o seletor se criou; senão, usa ano do sistema limitado à faixa)
ano_ref <- if (exists("input") && !is.null(input$ano_ref)) input$ano_ref else min(max(as.integer(format(Sys.Date(), "%Y")), 2020), 2030)
# casos do SINAN (seu banco) no ano escolhido
casos_ra <- dados_filtrados %>%
filter(ano == as.character(ano_ref),
regiao %in% RAs_ALVO) %>%
count(regiao, name = "casos")
# denominadores do mesmo ano (2020–2030)
denominadores <- get_denominadores_ra(ano_ref)
# incidência por 100k
incid_ra <- casos_ra %>%
right_join(denominadores, by = "regiao") %>%
mutate(
casos = tidyr::replace_na(casos, 0),
incidencia_100k = ifelse(populacao > 0, (casos / populacao) * 1e5, NA_real_),
incidencia_100k = round(incidencia_100k, 1) # <= aqui arredonda para 1 casa
) %>%
arrange(desc(incidencia_100k))
```
Column {data-width=150}
-----------------------------------------------------------------------
###
```{r}
### Total de casos
valueBox(
value = total_casos,
caption = "Sífilis adquirida",
color = "#3498db"
)
```
###
```{r}
### Sífilis feminina
valueBox(
value = num_feminino,
caption = "Sífilis feminina",
icon = "fa-female",
color = "#9b59b6"
)
```
###
```{r}
### Sífilis Masculina
valueBox(
value = num_masculino,
caption = "Sífilis masculina",
icon = "fa-male",
color = "#2ecc71"
)
```
Row {data-height=650}
-----------------------------------------------------------------------
```{r, echo=FALSE}
# Piramide etária
p <- ggplot(dados_piramide, aes(x = faixa_etaria, y = n, fill = CS_SEXO)) +
geom_bar(stat = "identity", width = 0.8) +
coord_flip() +
scale_y_continuous(
breaks = seq(-max(abs(dados_piramide$n)), max(abs(dados_piramide$n)), by = 5),
labels = abs(seq(-max(abs(dados_piramide$n)), max(abs(dados_piramide$n)), by = 5))
) +
labs(
y = "Pessoas com sífilis adquirida",
x = "Faixa Etária",
title = "Pirâmide Etária por Sexo",
fill = "Sexo"
) +
scale_fill_manual(values = c("Masculino" = "#2ecc71", "Feminino" = "#9b59b6")) +
theme_minimal() +
theme(
panel.background = element_rect(fill = "transparent", color = NA),
plot.background = element_rect(fill = "transparent", color = NA),
legend.background = element_rect(fill = "transparent"),
legend.box.background = element_rect(fill = "transparent"),
plot.title = element_text(size = 14, face = "bold")
)
ggplotly(p) %>% layout(plot_bgcolor = 'rgba(0,0,0,0)', paper_bgcolor = 'rgba(0,0,0,0)')
###
### Gráfico de raça
dados_raca <- dados_filtrados %>%
filter(!is.na(CS_RACA)) %>%
count(CS_RACA)
grafico_raca <- ggplot(dados_raca, aes(x = reorder(CS_RACA, -n), y = n, fill = CS_RACA)) +
geom_bar(stat = "identity", width = 0.7) +
labs(
x = "Raça/Cor",
y = "Pessoas com sífilis adquirida"
) +
scale_fill_brewer(palette = "Set2") +
theme_minimal() +
theme(
panel.background = element_rect(fill = "transparent", color = NA),
plot.background = element_rect(fill = "transparent", color = NA),
legend.position = "none",
plot.title = element_text(size = 14, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1)
)
plotly::ggplotly(grafico_raca) %>%
layout(plot_bgcolor = 'rgba(0,0,0,0)', paper_bgcolor = 'rgba(0,0,0,0)')
###
## TABELA DE INCIDÊNCIA (compacta e proporcional) ---
css_tbl <- htmltools::tags$style(htmltools::HTML("
/* compacta e evita barra horizontal */
.dataTables_wrapper { overflow: visible !important; }
table.dataTable { width: 100% !important; }
table.dataTable.compact thead th,
table.dataTable.compact tbody td { padding: 6px 8px; }
/* permite quebra de linha para caber sem scroll */
table.dataTable td, table.dataTable th {
white-space: normal; /* quebra linha */
word-break: break-word;
}
"))
tbl_incid <- incid_ra %>%
mutate(
casos = as.numeric(casos),
populacao = as.numeric(populacao),
incidencia_100k = round(incidencia_100k, 1)
)
htmltools::tagList(
css_tbl,
htmltools::div(
style = "max-width: 900px; margin: 0; height: auto; overflow: visible;",
DT::datatable(
tbl_incid,
rownames = FALSE,
class = "compact stripe hover order-column",
options = list(
dom = 't', # só a tabela (sem busca, sem info, sem paginação)
paging = FALSE,
searching = FALSE,
info = FALSE,
autoWidth = TRUE, # deixa o DT ajustar as larguras
# alinhar numéricos à direita e limitar largura da 1ª coluna
columnDefs = list(
list(width = '35%', targets = 0),
list(className = 'dt-right', targets = c(1,2,3))
)
)
) |>
DT::formatCurrency(c("casos","populacao"), currency = "", digits = 0,
interval = 3, mark = ".", dec.mark = ",") |>
DT::formatRound("incidencia_100k", digits = 1, mark = ".", dec.mark = ",")
)
)
```
Column {data-height=400}
-----------------------------------------------------------------------
```{r}
# Processar os dados - extrair apenas o número da semana
dados_semana <- dados_filtrados %>%
mutate(SEM_NOT = substr(SEM_NOT, 5, 6)) %>% # Pegar apenas os últimos 2 dígitos (01 a 52)
count(SEM_NOT) %>%
arrange(SEM_NOT) %>% # Ordenar corretamente
mutate(SEM_NOT = factor(SEM_NOT, levels = unique(SEM_NOT))) # Manter a ordem
# Gráfico de área otimizado
grafico_semana <- ggplot(dados_semana, aes(x = SEM_NOT, y = n, group = 1)) +
geom_area(fill = "#3498db", alpha = 0.5, color = "#2980b9", linewidth = 0.8) + # Área com preenchimento
geom_point(color = "#2980b9", size = 2.5) + # Pontos destacados
labs(
x = "Semana Epidemiológica",
y = "Número de notificações"
) +
theme_minimal() +
theme(
panel.background = element_rect(fill = "#f5f5f5", color = NA), # Cor de fundo do painel
plot.background = element_rect(fill = "#f5f5f5", color = NA), # Cor de fundo do gráfico
panel.grid.major.y = element_line(color = "white", linewidth = 0.5),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
axis.text.x = element_text(angle = 0, hjust = 0.5, size = 9),
axis.title = element_text(size = 10, color = "#333333"),
axis.text = element_text(color = "#333333"),
plot.margin = margin(5, 20, 5, 20)
) +
scale_y_continuous(expand = expansion(mult = c(0, 0.1))) +
scale_x_discrete(breaks = function(x) x[seq(1, length(x), by = max(1, floor(length(x)/10)))])
# Versão interativa com fundo harmonizado
ggplotly(grafico_semana, height = 400, tooltip = c("x", "y")) %>%
layout(
title = list(
text = "Notificações por semana epidemiológica",
x = 0.5, # Centraliza o título
xanchor = "center",
font = list(size = 16, color = "#333333", family = "Arial Black")
),
autosize = TRUE,
plot_bgcolor = '#f5f5f5', # Cor de fundo do gráfico
paper_bgcolor = '#f5f5f5', # Cor de fundo da área externa
margin = list(l = 50, r = 50, b = 50, t = 60, pad = 0), # aumentei o topo (t) para dar espaço ao título
xaxis = list(
showgrid = FALSE,
tickangle = 0,
tickfont = list(size = 10, color = "#333333"),
title = list(font = list(color = "#333333"))
),
yaxis = list(
gridcolor = 'rgba(255,255,255,0.8)',
tickfont = list(color = "#333333"),
title = list(font = list(color = "#333333")),
automargin = TRUE
),
hoverlabel = list(
bgcolor = "white",
font = list(color = "#333333")
)
) %>%
config(displayModeBar = FALSE)
###
## Gráficos dos Bairros
grafico_bairro <- ggplot(dados_bairro_ano, aes(x = reorder(ID_BAIRRO, n), y = n, fill = regiao)) +
geom_col() +
coord_flip() +
labs(
title = "Notificações por Bairro",
x = "Bairro",
y = "Número de notificações",
fill = "Região"
) +
scale_fill_manual(values = c(
"Fercal" = "#e41a1c",
"Planaltina" = "#377eb8",
"Sobradinho" = "#4daf4a",
"Sobradinho II" = "#984ea3",
"Sem região" = "#999999"
)) +
theme_minimal() +
theme(
panel.background = element_rect(fill = "transparent", color = NA),
plot.background = element_rect(fill = "transparent", color = NA),
plot.title = element_text(size = 14, face = "bold")
)
# Interativo
ggplotly(grafico_bairro) %>%
layout(
plot_bgcolor = 'rgba(0,0,0,0)',
paper_bgcolor = 'rgba(0,0,0,0)'
)
###
## Mapa
centros_ra <- tibble::tribble(
~regiao, ~lat, ~lng,
"Planaltina", -15.617, -47.650,
"Sobradinho", -15.650, -47.783,
"Sobradinho II", -15.712, -47.834,
"Fercal", -15.555, -47.740
)
map_pts <- centros_ra %>%
left_join(incid_ra, by = "regiao") %>%
mutate(
popup = sprintf(
"%sCasos: %sPopulação: %sIncidência: %s/100 mil",
regiao,
formatC(casos, format = "d", big.mark = "."),
formatC(populacao, format = "d", big.mark = "."),
format(round(incidencia_100k, 1), big.mark = ".", decimal.mark = ",")
)
)
leaflet(map_pts) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addCircleMarkers(
lng = ~lng, lat = ~lat,
radius = ~pmax(6, scales::rescale(incidencia_100k, to = c(6, 18), from = range(incidencia_100k, na.rm = TRUE))),
stroke = TRUE, weight = 1, fillOpacity = 0.85,
label = ~lapply(popup, htmltools::HTML),
popup = ~lapply(popup, htmltools::HTML)
) %>%
fitBounds(lng1 = min(map_pts$lng)-0.05, lat1 = min(map_pts$lat)-0.05,
lng2 = max(map_pts$lng)+0.05, lat2 = max(map_pts$lat)+0.05)
```