app-mpt/scripts/projection_summary.R

#!/usr/bin/env Rscript

library(tidyverse)
library(lubridate)

categories_mode <- function(x) {
    summarize (x,
               cnae_secao = names(which.max(table(cnae_secao))),
               ds_natureza_lesao = names(which.max(table(ds_natureza_lesao))),
               cbo_grande_grupo = names(which.max(table(cbo_grande_grupo))),
               agrupamento_parte_do_corpo = names(which.max(table(agrupamento_parte_do_corpo))),
               ds_grupo_agcausadores = names(which.max(table(ds_grupo_agcausadores))),
               ds_tipo_acidente = names(which.max(table(ds_tipo_acidente))),
               ds_tipo_local_acidente = names(which.max(table(ds_tipo_local_acidente))),
               turno = names(which.max(table(turno)))
               )
}

#count occurrences of each category in a collumn and spread it
# TODO make passing column name work!
#spread_occurrences <- function(x, y) {
#    x %>%
#    group_by(pais, regiao, uf, mesorregiao, microrregiao, municipio) %>%
#    count(y) %>%
#    spread(y, n, fill = 0)
#}

cnaes <- read_csv2("../app/data/cnae_organizado.csv")
cbos <- read_csv2("../app/data/cbo_organizado.csv")
partes_do_corpo <- read_csv2("../app/data/parte_do_corpo_organizado.csv")
agente_causador <- read_csv2("../app/data/agente_causador_organizado.csv")
complete <- read_csv2("../app/data/completo.csv", na = c("NA", "", "Não informado"),
                      col_types = cols(
                          pais = col_character(),
                          regiao = col_character(),
                          uf = col_character(),
                          mesorregiao = col_character(),
                          microrregiao = col_character(),
                          municipio = col_character(),
                          st_acidente_feriado = col_character(),
                          ds_agente_causador = col_character(),
                          ano_cat = col_integer(),
                          ds_cnae_classe_cat = col_character(),
                          dt_acidente = col_date(),
                          st_dia_semana_acidente = col_character(),
                          ds_emitente_cat = col_character(),
                          hora_acidente = col_time(),
                          idade_cat = col_integer(),
                          cd_indica_obito = col_character(),
                          ds_natureza_lesao = col_character(),
                          ds_cbo = col_character(),
                          ds_parte_corpo_atingida = col_character(),
                          cd_tipo_sexo_empregado_cat = col_character(),
                          ds_tipo_acidente = col_character(),
                          ds_tipo_local_acidente = col_character()
                      ))

# Remove unnecessary columns
complete <- complete[-c(7, 9, 11, 12)]
complete <- drop_na(complete)

# Change absolute hour to "shifts"
complete <- complete %>% mutate(turno = case_when(
                                    hora_acidente >= hm("06:00") & hora_acidente  < hm("18:00") ~ "Diurno",
                                    TRUE ~ "Noturno"))

# Remove absolute hour
complete <- complete[-10]

# Group CNAES in higher hierarchy
complete <- complete %>% inner_join(cnaes, by = "ds_cnae_classe_cat")
complete <- complete %>% inner_join(cbos, by = "ds_cbo")
complete <- complete %>% inner_join(partes_do_corpo, by = "ds_parte_corpo_atingida")
complete <- complete %>% inner_join(agente_causador, by = "ds_agente_causador")

#remove old classification
complete <- complete[-c(7,8,13,14)]

#this data is necessar for parallel coordinates summaries
write_delim(complete, "../app/data/paracoord_data.csv", delim = ";")

# Temporary: seems emitente is not necessary so remove it
complete <- complete[-7]

# Summarize with mode to colour the data
categories <- group_by(complete, regiao, uf, mesorregiao, microrregiao, municipio) %>%
    categories_mode() %>%
    arrange(regiao, uf, mesorregiao, microrregiao, municipio)
saveRDS(categories, "../app/data/rds/categories.rds")

# This is ugly, we really need that function
d <- complete %>%
    group_by(pais, regiao, uf, mesorregiao, microrregiao, municipio) %>%
    count(ds_natureza_lesao) %>%
    mutate(n = (round(n / sum(n), 4))) %>%
    spread(ds_natureza_lesao, n, fill = 0)

d2 <- complete %>%
    group_by(pais, regiao, uf, mesorregiao, microrregiao, municipio) %>%
    count(ds_tipo_acidente) %>%
    mutate(n = (round(n / sum(n), 4))) %>%
    spread(ds_tipo_acidente, n, fill = 0)

d3 <- complete %>%
    group_by(pais, regiao, uf, mesorregiao, microrregiao, municipio) %>%
    count(ds_tipo_local_acidente) %>%
    mutate(n = (round(n / sum(n), 4))) %>%
    spread(ds_tipo_local_acidente, n, fill = 0)

d4 <- complete %>%
    group_by(pais, regiao, uf, mesorregiao, microrregiao, municipio) %>%
    count(cnae_secao) %>%
    mutate(n = (round(n / sum(n), 4))) %>%
    spread(cnae_secao, n, fill = 0)

d5 <- complete %>%
    group_by(pais, regiao, uf, mesorregiao, microrregiao, municipio) %>%
    count(cbo_grande_grupo) %>%
    mutate(n = (round(n / sum(n), 4))) %>%
    spread(cbo_grande_grupo, n, fill = 0)

d6 <- complete %>%
    group_by(pais, regiao, uf, mesorregiao, microrregiao, municipio) %>%
    count(agrupamento_parte_do_corpo) %>%
    mutate(n = (round(n / sum(n), 4))) %>%
    spread(agrupamento_parte_do_corpo, n, fill = 0)

d7 <- complete %>%
    group_by(pais, regiao, uf, mesorregiao, microrregiao, municipio) %>%
    count(ds_grupo_agcausadores) %>%
    mutate(n = (round(n / sum(n), 4))) %>%
    spread(ds_grupo_agcausadores, n, fill = 0)

#extra 'd' for the other fields we need
d8 <- complete %>%
    group_by(pais, regiao, uf, mesorregiao, microrregiao, municipio) %>%
    summarize(
        idade = mean(idade_cat),
        obito = sum(cd_indica_obito == "N")/(n()),
        sexo = sum(cd_tipo_sexo_empregado_cat == "Masculino")/(n()),
        turno = sum(turno == "Diurno")/(n())
    )

complete <- d %>%
    inner_join(d2, by = c("pais", "regiao", "uf", "mesorregiao", "microrregiao", "municipio")) %>%
    inner_join(d3, by = c("pais", "regiao", "uf", "mesorregiao", "microrregiao", "municipio")) %>%
    inner_join(d4, by = c("pais", "regiao", "uf", "mesorregiao", "microrregiao", "municipio")) %>%
    inner_join(d5, by = c("pais", "regiao", "uf", "mesorregiao", "microrregiao", "municipio")) %>%
    inner_join(d6, by = c("pais", "regiao", "uf", "mesorregiao", "microrregiao", "municipio")) %>%
    inner_join(d7, by = c("pais", "regiao", "uf", "mesorregiao", "microrregiao", "municipio")) %>%
    inner_join(d8, by = c("pais", "regiao", "uf", "mesorregiao", "microrregiao", "municipio")) %>%
    arrange(regiao, uf, mesorregiao, microrregiao, municipio)

write_delim(complete, "../app/data/proj/projection_data.csv", delim = ";")