Column

378

146

232

Row

Column

---
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)
```