Etapa 1: Análise do panorama geral no mundo

Objetivo: Analisar dados referêntes a taxa de suicídio e obter insigths a partir de algumas hipóteses

Descrição

Para este trabalho foi utilizado uma base de dados disponibilizada na plataforma Kaggle https://www.kaggle.com/russellyates88/suicide-rates-overview-1985-to-2016, este dataset é um compilado de outros 4 conjuntos de dados vinculados: Programa das Nações Unidas para o Desenvolvimento. (2018). Índice de desenvolvimento humano (IDH). Recuperado em http://hdr.undp.org/en/indicators/137506

Banco Mundial. (2018). Indicadores de desenvolvimento mundial: PIB (US $ atual) por país: 1985 a 2016. Recuperado em http://databank.worldbank.org/data/source/world-development-indicators#

Szamil. Suicídio no século XXI conjunto de dados. Obtido em https://www.kaggle.com/szamil/suicide-in-the-twenty-first-century/notebook

Organização Mundial de Saúde. (2018). Prevenção de suicídio. Recuperado em http://www.who.int/mental_health/suicide-prevention/en/

Dicionario dos dados

country: país onde os dados foram registrados “n” 101 países

year: ano em que os dados foram registrados 1987 a 2016

sex: sexo considerado no registro male – masculino female – feminino

age: faixa etária considerada 5-14 anos 15-24 anos 25-34 anos 35-54 anos 55-74 anos 75+ anos

suicides_no: número de suicídios

population: população para o grupo

suicides/100k pop: número de suicídios por 100 mil habitantes

country_year: identificador contendo country + year

HDI for year: Índice de Desenvolvimento Humano (IDH) para o ano

gdp_for_year: Produto Interno Bruto (PIB) para o ano

gdp_per_capita: Produto Interno Bruto (PIB) per capita

Análise exploratória dos dados

Carregando os pacotes que seram utilizados para a análise

#install.packages("readr")
#install.packages("visdat")
#install.packages("dplyr")
#install.packages("plotly")
#install.packages("ggplot2")
#install.packages("corrplot")
#install.packages("knitr")
#install.packages("webshot")
library(webshot)
#webshot::install_phantomjs()
library(knitr)
library(readr)
library(visdat)
library(tidyr)
library(dplyr)
library(plotly)
library(corrplot)
library(ggplot2)
library(plotly)

setwd("~/Portfolio/TCC/Dados")

Abaixo segue uma pequena amostra dos dados para que possamos entender como eles estão organizados

df=read_csv(file="C:/Users/italo/OneDrive/Documents/Portfolio/TCC/Dados/master.csv")
head(df)

Iremos alterar os nomes das colunas do dataset para ficar mais simples de enteder as análises feitas. Utilizaremos nomes em português com significados iguais ou com significado semelhantes com a variável relacionada.

names(df)= c("pais","ano","sexo","idade","num_suicidio","população","suicidios/100k","idendificador","IDH","PIB","Renda_per_capita","geracao")
head(df)

Tratamento de dados

Inicialmente iremos avaliar se o dataset possuem algum valor faltante.Abaixo é possível perceber que possuimos apenas dados faltantes na variavel IDH com 70% dos seus dados NA’s, devido ao número muito grande de dados faltantes decidimos retirar a variavel da análise.

df["IDH"]=NULL

Para começarmos a fazer qualquer tipo de analise, precisamos antes de tudo validar se as variaveis do nosso dataset estão formatadas com tipo de dados certo. Para ficar visualmente mais atrativo, decidi utilizar o pacote visdat.

vis_dat(df)

É necessário alterar os tipos da variavel idade, geração, país, sexo para o tipo de dados chamado factor, tipo especifico para variáveis de classificação de dados.

df$pais= as.factor(df$pais)
df$sexo= as.factor(df$sexo)
df$idade= as.factor(df$idade)
df$geracao=as.factor(df$geracao)
vis_dat(df)

Analise descritiva dos dados

Iremos analisar de forma rápida como cada variável estar distribuidas em relação as medidas de tendência central

summary(df)

##           pais            ano           sexo               idade     
##  Austria    :  382   Min.   :1985   female:13910   15-24 years:4642  
##  Iceland    :  382   1st Qu.:1995   male  :13910   25-34 years:4642  
##  Mauritius  :  382   Median :2002                  35-54 years:4642  
##  Netherlands:  382   Mean   :2001                  5-14 years :4610  
##  Argentina  :  372   3rd Qu.:2008                  55-74 years:4642  
##  Belgium    :  372   Max.   :2016                  75+ years  :4642  
##  (Other)    :25548                                                   
##   num_suicidio       população        suicidios/100k   idendificador     
##  Min.   :    0.0   Min.   :     278   Min.   :  0.00   Length:27820      
##  1st Qu.:    3.0   1st Qu.:   97498   1st Qu.:  0.92   Class :character  
##  Median :   25.0   Median :  430150   Median :  5.99   Mode  :character  
##  Mean   :  242.6   Mean   : 1844794   Mean   : 12.82                     
##  3rd Qu.:  131.0   3rd Qu.: 1486143   3rd Qu.: 16.62                     
##  Max.   :22338.0   Max.   :43805214   Max.   :224.97                     
##                                                                          
##       PIB            Renda_per_capita            geracao    
##  Min.   :4.692e+07   Min.   :   251   Boomers        :4990  
##  1st Qu.:8.985e+09   1st Qu.:  3447   G.I. Generation:2744  
##  Median :4.811e+10   Median :  9372   Generation X   :6408  
##  Mean   :4.456e+11   Mean   : 16866   Generation Z   :1470  
##  3rd Qu.:2.602e+11   3rd Qu.: 24874   Millenials     :5844  
##  Max.   :1.812e+13   Max.   :126352   Silent         :6364  
##

Iremos avaliar apenas a variavel suicidios/100k de habitantes, cabe ao leitor tirar suas proprias conclusões para as outras variáveis apresentadas. Temos uma média de 12.82 suicidios a cada 100 mil habitantes nos dados, porém sua média e medianas são bem distantes uma das outras isso mostra que os dados estão bastante esparços e possuem vários picos que fazem a média subir bastante.

Analise Exploratoria nível de País

Para fazer a analise iremos usar como ideia central algumas perguntas para fazermos aos dados

Ao passar dos anos, qual foi a quantidade de suicídios ?

x=aggregate(df[,"suicidios/100k"], list(local=df$ano), sum)
g=ggplot(data=x, aes(x=local,y=`suicidios/100k`)) + geom_col(fill="black") + theme_classic() +
  labs(title = "Total de suícidios no mundo de 1985 até 2016") + xlab("Anos") + ylab("Número de suicídios por 100k de hab")
ggplotly(g)

O gráfico acima mostra que o número de suicídios por 100 mil habitantes veio de um crescimento rápido e encontrou seu pico entre os anos de 1995 a 2002, depois os dados desmonstram uma tendência decrescente.

Qual faixa etária que tem mais suicídios no mundo ? Crianças, adolescentes, adultos ou idosos ?

Qual métrica utilizar, por 100k ou total ?

x=aggregate(df[,"suicidios/100k"], list(local=df$idade), sum)
ggplot(data=x,aes(x=local, y=`suicidios/100k`, fill=local)) + geom_col(color="black",show.legend = FALSE) + theme_classic()+
  labs(title = "Quantidade de suícidios por faixa etária por 100k de hab") + xlab("Faixa Etária") + ylab("Numéro de suícidios")

— Fazer analise dos sucidios

Se suicidam mais pessoas do sexo masculino ou feminino ?

x=aggregate(df[,"suicidios/100k"], list(local=df$sexo), sum)
g=ggplot(data=x, aes(x=local, y=`suicidios/100k`)) + geom_col(fill="black") + theme_classic() + labs(title = "Total de suícidios por sexo") + ylab("Número de suícidios por 100k de Hab") + xlab("Sexo") + scale_y_continuous(labels = function(x) format(x, scientific = FALSE))
ggplotly(g)

–Fazer análise por sexo

Será que o padrão de homens se suicidarem mais que mulheres seguem esse padrão para todas as faixas etarias ?

ggplot(data=df, aes(x=sexo, y=`suicidios/100k`, fill=idade)) + geom_bar(stat="identity", show.legend = FALSE) + facet_wrap(df$idade) + xlab("Sexo") + labs(title = "Total de suicídios por idade e sexo") + theme_classic() + ylab("Número de suicídio por 100k Hab")

— Fazer analise de sucididio por sexo e idade

Quais os países que mais pessoas suicidam ?

x=aggregate(df[,"suicidios/100k"], list(local=df$pais), sum)
x=x[order(x[,2],decreasing = T),]
x$indice=c(1:101)
x=x[x$indice<11,]
ggplot(data=x, aes(x=reorder(local,-indice), y=`suicidios/100k`)) + geom_col() + coord_flip() + theme_classic()+ labs(title = "10 países com mais mortes por suícidio por 100 mil Habitantes") +
  ylab("Países") + xlab("Suicídio/100k") + geom_text(aes(label=`suicidios/100k`))

— Analise do Gráfico

Qual a geração que mais se suicidou ? Talvez tire

x=aggregate(df$`suicidios/100k`, list(local=df$geracao), sum)
ggplot(data=x, aes(x=local, y=x)) + geom_col() + theme_classic() + labs(title = "Suícidio por geração") + xlab("Geração") + ylab("Número de suicídio por 100k de hab")

—-Fazer análise

Como se dar os suícidios pela renda das pessoas

ggplot(data=df, aes(x=Renda_per_capita, y=df$`suicidios/100k`)) + geom_point()+ geom_density2d(colour="white")+ theme_bw() + scale_x_continuous(labels = function(x) format(x, scientific = FALSE)) + labs(title = "Número de suícidios pela renda per capita") + xlab("Renda") + ylab("Número de suicídios")

– Fazer analises

#Parte 2: Análise de Dados do brasil com base no SUS

Pré Processamento da da base de dados

Para segunda parte do projeto será necessário a utilização de dados no portal do SUS (DATASUS) do SIM (Sistema de informação de mortalidade) que possuem as informações oficiais do Brasil em relação as mortes por suicídio . Quando analisei as informações no site percebi que para uma pessoa coletar todas as informações precisaria de pelo menos uns 20 arquivos csv’s. Pensando nisso essa parte do projeto foi criada para coletar todos os datasets separados e agrupar suas informações. Essa etapa se faz essêncial para que seja possível analisar as informações do Brasil referêntes a suicídio.

Couteudo = Óbitos p/ocrorrencia Grupo CID10= Lesões autoprovocadas intencionalmente Grande Grupo CID10= Lesões autoprovocadas voluntariamente

Fonte: http://tabnet.datasus.gov.br/cgi/deftohtm.exe?sim/cnv/ext10uf.def.

Bibliotecas

#install.packages("dplyr")
library(dplyr)
#install.packages("tidyr")
library(tidyr)
#install.packages("readr")
library(readr)

Para que o leitor tenha uma ideia de como os dados estão organizado, abaixo tem uma amostra de um dos arquivos baixados que trata de informações de suicídio por Estado.

df=read.csv("C:/Users/italo/OneDrive/Documents/Portfolio/TCC/Dados/SucidioPorRegiao.csv", sep = ";")
head(df)

Note que temos colunas como Ano.mês.do.Óbito que está mal formatada e mistura linhas com total no ano com o total para cada mês. Além disso para cada estado foi criado uma coluna o que dificulta as possíveis análises feitas com o tema, embora não seja mostrado no slice acima a base também possuiam textos não relacionados aos dados no início e no final do arquivo que foram retirados.

Para fazer este tratamento foi criado a função abaixo, ela resolverá todos os problemas relatados anteriormente.

trataDados <- function(df,x){
#Reunindo os estados em uma coluna
df=gather(df,UF,Suicidios,2:x)
names(df)[1]= "Ano.Mes"

#Retirando textos que estão no meio da tabela
df=df[!is.na(df$Suicidios),]
df=df[!is.null(df$Suicidios)]
df=df[!(df$Suicidios==""),]

#Retirando valores de totais anuais
df=filter(df,!df$Ano.Mes %in% c(1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,
                               2006,2007,2008,2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019))

#Retirando a linha que contem o total 
df=filter(df, !df$Ano.Mes %in% c("Total"))

#Separando a coluna Ano.Mês.do.Obito em ano e mês

chave=paste(df$Ano.Mes,df$UF,sep="_")
df=separate(df,Ano.Mes,into=c("Mes","Ano"), sep="/")

#Colocando uma coluna de chave para fazer a união das futuras tabelas
df$chave=chave

#Retira os dois pontos que ficou na frente de texto
df$Mes=gsub("\\.\\.","",df$Mes)


#Transforma dados em inteiros, isso vai gerar NAS quando o valor for "-"
df$Suicidios=as.integer(df$Suicidios)

#Substituindo os valores NAs gerados por "0"
df[is.na(df$Suicidios),"Suicidios"]=0

return(df)
}


df= trataDados(df,29)

## Note: Using an external vector in selections is ambiguous.
## i Use `all_of(x)` instead of `x` to silence this message.
## i See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This message is displayed once per session.

## Warning in trataDados(df, 29): NAs introduzidos por coerção

df=filter(df, !df$UF %in% c("Total"))

Tratando os os dados relacionado aos obitos por sexo

SuicidioFem= read.csv("C:/Users/italo/OneDrive/Documents/Portfolio/TCC/Dados/SuicidioPorSexoFem.csv",sep=";")
SuicidioMasc= read.csv("C:/Users/italo/OneDrive/Documents/Portfolio/TCC/Dados/SuicidioPorSexoMasc.csv",sep=";")
SuicidioIgn= read.csv("C:/Users/italo/OneDrive/Documents/Portfolio/TCC/Dados/SuicidioPorSexoIgn.csv",sep=";")

SuicidioFem=trataDados(SuicidioFem,29)

## Warning in trataDados(SuicidioFem, 29): NAs introduzidos por coerção

SuicidioMasc=trataDados(SuicidioMasc,29)

## Warning in trataDados(SuicidioMasc, 29): NAs introduzidos por coerção

SuicidioIgn= trataDados(SuicidioIgn,16)

## Warning in trataDados(SuicidioIgn, 16): NAs introduzidos por coerção

SuicidioFem$Sexo="Feminino"
SuicidioMasc$Sexo="Masculino"
SuicidioIgn$Sexo="Ign"
sexo=rbind(SuicidioFem,SuicidioMasc)
sexo=rbind(sexo,SuicidioIgn)

Tratando dados Relacionados a Cor

SuicidioPorCor<- read.csv("C:/Users/italo/OneDrive/Documents/Portfolio/TCC/Dados/SuicidioPorCor.csv", header = T, sep=";")
SuicidioPorCor=trataDados(SuicidioPorCor,8)

## Warning in trataDados(SuicidioPorCor, 8): NAs introduzidos por coerção

names(SuicidioPorCor)[3]="Cor"
SuicidioPorCor=filter(SuicidioPorCor, !SuicidioPorCor$Cor %in% c("Total"))
SuicidioPorCor$chave=NULL

Tratando dados Relacionados a Cor padrão IBGE

# Colocando os dados em Padrão IBGE
PretoPardo=group_by(filter(SuicidioPorCor, SuicidioPorCor$Cor %in% c("Preta","Parda")),Mes,Ano)%>%summarise(Suicidios=sum(Suicidios))

## `summarise()` regrouping output by 'Mes' (override with `.groups` argument)

PretoPardo$Cor="Pretos e Pardos"

SuicidioPorCorIBGE=rbind(filter(SuicidioPorCor, !SuicidioPorCor$Cor %in% c("Preta","Parda")), PretoPardo)

Tratando dados Relacionados a suicidio por Local

SuicidioPorLocal<-read.csv("C:/Users/italo/OneDrive/Documents/Portfolio/TCC/Dados/SuicidioPorLocal.csv", header = T, sep=";")
SuicidioPorLocal=trataDados(SuicidioPorLocal,8)

## Warning in trataDados(SuicidioPorLocal, 8): NAs introduzidos por coerção

names(SuicidioPorLocal)[3]=c("Local")
SuicidioPorLocal=filter(SuicidioPorLocal,!SuicidioPorLocal$Local %in% c("Total"))

Tratamento Dados Relacionados a suicidio por Faixa Etaria

SuicidioPorFaixaEtaria<-read.csv("C:/Users/italo/OneDrive/Documents/Portfolio/TCC/Dados/SuicidioPorFaixaEtaria.csv", header = T, sep=";")
SuicidioPorFaixaEtaria=trataDados(SuicidioPorFaixaEtaria,15)

## Warning in trataDados(SuicidioPorFaixaEtaria, 15): NAs introduzidos por coerção

names(SuicidioPorFaixaEtaria)[3]="FaixaEtaria"
SuicidioPorFaixaEtaria=filter(SuicidioPorFaixaEtaria,!SuicidioPorFaixaEtaria$FaixaEtaria %in% c("Total"))

Tratamento Dados Relacionados a suicidio por Estado Civil

SuicidioPorEstadoCivil<- read.csv("C:/Users/italo/OneDrive/Documents/Portfolio/TCC/Dados/SuicidioPorEstadoCivil.csv", header = T, sep=";")
SuicidioPorEstadoCivil=trataDados(SuicidioPorEstadoCivil,29)

## Warning: Expected 2 pieces. Missing pieces filled with `NA` in 168 rows [1, 2,
## 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, ...].

SuicidioPorEstadoCivil$Ano=NULL
names(SuicidioPorEstadoCivil)[1]="EstadoCivil"

Tratamento de Dados Relacionado a suicidio por Tipo de Causa

SuicidioPorCausa<- read.csv("C:/Users/italo/OneDrive/Documents/Portfolio/TCC/Dados/SuicidioPorCausa.csv", header = T, sep=";")
SuicidioPorCausa=trataDados(SuicidioPorCausa,5)

## Warning: Expected 2 pieces. Missing pieces filled with `NA` in 72 rows [1, 2, 3,
## 4, 5, 7, 9, 10, 11, 13, 14, 15, 17, 18, 19, 21, 22, 23, 26, 27, ...].

## Warning in trataDados(SuicidioPorCausa, 5): NAs introduzidos por coerção

SuicidioPorCausa$Ano=NULL
names(SuicidioPorCausa)[1]="Causa"
names(SuicidioPorCausa)[2]="Sexo"
SuicidioPorCausa=filter(SuicidioPorCausa,!SuicidioPorCausa$Sexo %in% c("Total"))

Tratamento de dados relacionado a suicidio por cor e idade

SuicidioCorIdade<- read.csv("C:/Users/italo/OneDrive/Documents/Portfolio/TCC/Dados/SuicidioCorIdade.csv", header = T, sep=";")
SuicidioCorIdade= trataDados(SuicidioCorIdade,15)

## Warning: Expected 2 pieces. Missing pieces filled with `NA` in 84 rows [1, 2, 3,
## 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, ...].

## Warning in trataDados(SuicidioCorIdade, 15): NAs introduzidos por coerção

SuicidioCorIdade$Ano=NULL
names(SuicidioCorIdade)[1]="Cor"
names(SuicidioCorIdade)[2]="Idade"
SuicidioCorIdade=filter(SuicidioCorIdade,!SuicidioCorIdade$Idade %in% c("Total"))
SuicidioCorIdade$Cor=as.factor(SuicidioCorIdade$Cor)
SuicidioCorIdade$Idade=as.factor(SuicidioCorIdade$Idade)
SuicidioCorIdade$chave=NULL

## OBS= A base por cor esta diferente da base por cor e idade

Tratando dados relacionados a suicidio por cor e idade pelo padrão IBGE

# Colocando os dados em Padrão IBGE
PretoPardo=group_by(filter(SuicidioCorIdade, SuicidioCorIdade$Cor %in% c("Preta","Parda")),Idade)%>%summarise(Suicidios=sum(Suicidios))

## `summarise()` ungrouping output (override with `.groups` argument)

PretoPardo$Cor="Pretos e Pardos"

SuicidioCorIdadeIBGE=rbind(filter(SuicidioCorIdade, !SuicidioCorIdade$Cor %in% c("Preta","Parda")), PretoPardo)

Analise Descritiva dos dados

Com os dados devidamente tratados foi feito uma análise exploratória com objetivo de entender melhor o tema no brasil. As divisões abaixo está relacionada a cada base que foi tratada.

Suicidio Por estado

x=aggregate(df$Suicidios, list(local=df$UF), sum)
x=x[order(x[,2],decreasing = T),]
x$indice=c(1:27)
ggplot(x, aes(x=reorder(local,indice), y=x)) + geom_col() + theme_classic() + labs(title ="Suicidios por Estado") + ylab("Número de Suicídios") + xlab("")

-Fazer análises

Suicidios Por Causas no geral e para cada sexo

#Ordenando Suicidios pelas principais causas
x=aggregate(SuicidioPorCausa$Suicidios, list(local=SuicidioPorCausa$Causa), sum)
x=x[order(x[,2],decreasing = T),]
x$indice=c(1:25)
x=x[x$indice<11,]
ggplot(x, aes(x=reorder(local,-indice), y=x)) + geom_col() + coord_flip() + theme_classic() + labs(title ="Principais formas de Suicídio no Brasil") + ylab("Número de Suicídios") + xlab("")

Fazer Análises

SuicidioPorCausaMasc=subset(SuicidioPorCausa,SuicidioPorCausa$Sexo=="Masc")
x=aggregate(SuicidioPorCausaMasc$Suicidios, list(local=SuicidioPorCausaMasc$Causa), sum)
x=x[order(x[,2],decreasing = T),]
x$indice=c(1:25)
x=x[x$indice<11,]
ggplot(x, aes(x=reorder(local,-indice), y=x)) + geom_col() + coord_flip() + theme_classic() + labs(title ="Homens cometerem Suicídio no Brasil") + ylab("Número de Suicídios") + xlab("")

Fazer Análises

SuicidioPorCausaFem=subset(SuicidioPorCausa,SuicidioPorCausa$Sexo=="Fem")
x=aggregate(SuicidioPorCausaFem$Suicidios, list(local=SuicidioPorCausaFem$Causa), sum)
x=x[order(x[,2],decreasing = T),]
x$indice=c(1:25)
x=x[x$indice<11,]
ggplot(x, aes(x=reorder(local,-indice), y=x)) + geom_col() + coord_flip() + theme_classic() + labs(title ="Mulheres cometerem Suicídio no Brasil") + ylab("Número de Suicídios") + xlab("")

Fazer Análises

SuicidioPorCausaIgn=subset(SuicidioPorCausa,SuicidioPorCausa$Sexo=="Ign")
x=aggregate(SuicidioPorCausaIgn$Suicidios, list(local=SuicidioPorCausaIgn$Causa), sum)
x=x[order(x[,2],decreasing = T),]
x$indice=c(1:25)
x=x[x$indice<11,]
ggplot(x, aes(x=reorder(local,-indice), y=x)) + geom_col() + coord_flip() + theme_classic() + labs(title ="IGN's cometerem Suicídio no Brasil") + ylab("Número de Suicídios") + xlab("")

Fazer Análises

SUicidio por cor

### Padrão sem ser IBGE
#x= aggregate(SuicidioPorCor$Suicidios, list(local=SuicidioPorCor$Cor), sum)
#x=x[order(x[,2], decreasing = T),]
#x$indice= c(1:6)
#ggplot(x, aes(x=reorder(local,indice), y=x)) + geom_col() + theme_classic() + labs(title #="Nº de Suicidios por Cor") + ylab("Número de Suicídios") + xlab("")
############


x= aggregate(SuicidioPorCorIBGE$Suicidios, list(local=SuicidioPorCorIBGE$Cor), sum)
x=x[order(x[,2], decreasing = T),]
x$indice= c(1:5)
ggplot(x, aes(x=reorder(local,indice), y=x)) + geom_col() + theme_classic() + labs(title ="Nº de Suicidios por Cor (Padrão IBGE)") + ylab("Número de Suicídios") + xlab("")

### TENTAR GRAFICO DE LINHA/ APREDER A TRABALHAR COM DATAS

#install.packages("lubridate")
library(lubridate)

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

SuicidioPorCor$Ano= as.factor(SuicidioPorCor$Ano)
SuicidioPorCor$Cor=as.factor(SuicidioPorCor$Cor)
ggplot(SuicidioPorCor, aes(x=Cor, y=Suicidios, fill=Cor)) + geom_col() + labs(title ="Nº de Suicidios por Cor e por Ano") + ylab("Número de Suicídios") + xlab("") + theme_classic()+ theme(legend.direction = "vertical", axis.text.x = element_text(angle=-90)) + facet_wrap(SuicidioPorCor$Ano)

#Gráfico padrao IBGE
SuicidioPorCorIBGE$Ano= as.factor(SuicidioPorCorIBGE$Ano)
SuicidioPorCorIBGE$Cor=as.factor(SuicidioPorCorIBGE$Cor)
ggplot(SuicidioPorCorIBGE, aes(x=Cor, y=Suicidios, fill=Cor)) + geom_col() + labs(title ="Nº de Suicidios por Cor e por Ano(Padrão IBGE)") + ylab("Número de Suicídios") + xlab("") + theme_classic()+ theme(legend.direction = "vertical", axis.text.x = element_text(angle=-90)) + facet_wrap(SuicidioPorCorIBGE$Ano)

### Dados Fora do Padrão IBGE
#ggplot(SuicidioCorIdade, aes(x=Cor, y=Suicidios, fill=Cor))+ geom_col() + labs(title ="Nº de #Suicidios por Cor e por Idade") + ylab("Número de Suicídios") + xlab("") + #facet_wrap(SuicidioCorIdade$Idade) + theme_classic()+ theme(legend.direction = "vertical", #axis.text.x = element_text(angle=-90))
########


##Padrão IBGE e retirando idades menores de 10 anos
SuicidioCorIdadeIBGE=filter(SuicidioCorIdadeIBGE,!SuicidioCorIdadeIBGE$Idade %in% c("X1.a.4.anos", "Menor.1.ano"))
ggplot(SuicidioCorIdadeIBGE, aes(x=Cor, y=Suicidios, fill=Cor))+ geom_col() + labs(title ="Nº de Suicidios por Cor e por Idade(Padrão IBGE)") + ylab("Número de Suicídios") + xlab("") + facet_wrap(SuicidioCorIdadeIBGE$Idade) + theme_classic()+ theme(legend.direction = "vertical", axis.text.x = element_text(angle=-90))

Suicidio por Sexo

sexo$Ano= as.factor(sexo$Ano)
ggplot(sexo, aes(x=Sexo, y=Suicidios, fill=Sexo))+ geom_col() + labs(title ="Suicidio por Sexo") + ylab("Número de Suicídios") + xlab("") + theme_classic() +scale_y_continuous(labels = function(x) format(x, scientific = FALSE))

sexo$Ano= as.factor(sexo$Ano)
ggplot(sexo, aes(x=Sexo, y=Suicidios, fill=Sexo))+ geom_col() + labs(title ="Suicidio por Sexo por Ano") + ylab("Número de Suicídios") + xlab("") + theme_classic() +scale_y_continuous(labels = function(x) format(x, scientific = FALSE)) + facet_wrap(sexo$Ano) + coord_flip()+theme(legend.direction = "vertical", axis.text.x = element_text(angle=-90))

Graficos relacionado ao estado civil

x= aggregate(SuicidioPorEstadoCivil$Suicidios, list(local=SuicidioPorEstadoCivil$EstadoCivil), sum)
x=x[order(x[,2], decreasing = T),]
x$indice= c(1:6)
ggplot(x, aes(x=reorder(local,indice), y=x)) + geom_col() + theme_classic() + labs(title ="Suícidio por Estado Civil") + ylab("Número de Suicídios") + xlab("")

x=SuicidioPorEstadoCivil[SuicidioPorEstadoCivil$UF=="PE",]
x= aggregate(x$Suicidios, list(local=x$EstadoCivil), sum)
x=x[order(x[,2], decreasing = T),]
x$indice= c(1:6)
ggplot(x, aes(x=reorder(local,indice), y=x)) + geom_col() + theme_classic() + labs(title ="Suícidio por Estado Civil em PE") + ylab("Número de Suicídios") + xlab("")

Gráfico de local

x= aggregate(SuicidioPorLocal$Suicidios, list(local=SuicidioPorLocal$Local), sum)
x=x[order(x[,2], decreasing = T),]
x$indice= c(1:6)
ggplot(x, aes(x=reorder(local,indice), y=x)) + geom_col() + theme_classic() + labs(title ="Suicidio por local de Óbito") + ylab("Número de Suicídios") + xlab("")

Parte 3- Serie Temporal (Prevendo valores de Suicidio)

#install.packages("forecast")
library(forecast)

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

#install.packages("fpp3")
library(fpp3)

## Warning: package 'fpp3' was built under R version 4.0.5

## -- Attaching packages -------------------------------------------- fpp3 0.4.0 --

## v tibble      3.0.1     v feasts      0.2.1
## v tsibble     1.0.0     v fable       0.3.0
## v tsibbledata 0.3.0

## Warning: package 'tsibble' was built under R version 4.0.4

## Warning: package 'tsibbledata' was built under R version 4.0.4

## Warning: package 'feasts' was built under R version 4.0.4

## Warning: package 'fabletools' was built under R version 4.0.4

## Warning: package 'fable' was built under R version 4.0.4

## -- Conflicts ------------------------------------------------- fpp3_conflicts --
## x lubridate::date()      masks base::date()
## x plotly::filter()       masks dplyr::filter(), stats::filter()
## x fabletools::forecast() masks forecast::forecast()
## x tsibble::intersect()   masks base::intersect()
## x tsibble::interval()    masks lubridate::interval()
## x dplyr::lag()           masks stats::lag()
## x tsibble::setdiff()     masks base::setdiff()
## x tsibble::union()       masks base::union()

###Criando Serie

Decidir utilizar o objeto Tsibble para trabalhar com series temporais, atualmente é o método mais estruturado para trabalhar com esse tipo de problema. Embora não seja o caso desta análise, seria possível trabalhar com diversas series temporais ao mesmo tempo nesse objeto, em uma análise mais completa seria possível criar diversas séries temporais para cada estado do Brasil.

dados=group_by(df,Ano,Mes)%>%summarise(Suicidios=sum(Suicidios))

## `summarise()` regrouping output by 'Ano' (override with `.groups` argument)

dados$Mes=yearmonth(ymd(paste(dados$Ano,dados$Mes,"1",sep="/")))
serie=dados[,c("Mes","Suicidios")] %>%
  as_tsibble(index = Mes)

serie

Grafico de tempo

autoplot(serie,Suicidios) +
  labs(title="Taxa de suicídios no Brasil",
       subtitle = "Periodo: 1996-2018") + theme_bw()

Avaliando a serie temporal sobre suas principais características vemos que ela demonstra uma forte tendência de crescimento ao longo dos anos, parece existir um comportamento sazonal não muito forte e nenhum ciclo aparente no horizonte temporal de dados coletados.

Parcelas Sazonais

Para entender melhor o comportamento da serie, decidir avaliar seu comportamento por mês utilizando um gráfico sazonal para encontrar possíveis padrões nos dados.

serie %>%
  gg_season(Suicidios, labels = "both") + 
  labs(title = "Gráfico Sazonal: Suícidos no Brasil", 
       y="Suicidios/População")+
  theme_bw()

Analisando os dados Sozonais é perceptivel o crescimento das series todos os anos, embora não se pode afirmar que isso é algo puramente devido ao número de suicidios ou se deve também a melhora da forma de coleta dessas informações. Além disso, parece que os dados seguem um padrão de queda e aumento entre março, abril e maio. Também da para se notar um crescimento padrão no mês de setembro,o que justifica setembro ser o mês de prevenção ao suicidio.

Gráfico de Subséries Temporais

#dados=group_by(df,Ano,Mes)%>%summarise(Suicidios=sum(Suicidios))
ts(dados$Suicidios, start = 1996, frequency = 12) %>%
  ggsubseriesplot(ts) + 
  labs(title= "Média de Suicídios por Mês",
       y="Suicídios/População") +theme_bw()

Com esse gráfico fica mais evidente o padrão nos meses de fevereiro,março e abril. Com ele foi possivel perceber que existe uma flutuação em que os mês em média com menor quantidade de suicidios é julho.

Avaliando possíveis series temporais que possam ter ligação com o número de suicídios

Para a previsão da série de suícidios e para procura de alguma correlação entre os valores que possam dar indício de talvez uma possível variável preditora para modelos de séries temporais que utilizam outras séries como preditoras.

Utilizarei as seguintes séries históricas:

Indice de desenvolvimento Humano (IDH): Mede o desempenho médio em três dimensões básicas de desenvolvimento humano - uma vida longa e saudável, conhecimento e padrão de vida decente. Link para dados: http://hdr.undp.org/en/indicators/137506
Taxa de Desemprego: Mede a taxa de desemprego no Brasil por trimestre
PIb: Mede o PIB em reais per capita no Brasil ao longo dos ultimos anos até 2018 link:https://www.ibge.gov.br/estatisticas/economicas/contas-nacionais/9300-contas-nacionais-trimestrais.html?=&t=series-historicas&utm_source=landing&utm_medium=explica&utm_campaign=pib#evolucao-taxa

Indice de Desenvolvimento Humando (IDH)

Decomposição da série temporal

Para finalizar essa análise exploratória farei a decomposição da série nos seguintes componentes: -Ciclo de tendência -Sazonalidade -Componentes remanescente

Isso ajudará a entender o comportamente da taxa de suicídios no Brasil, mas antes de decompor irei fazer uma transformação e ajustar seus dados para facilitar a análise e posteriores manipulações que serão feitas.

Transformaçao e ajuste

Utilizarei a transformação Box-Cox, onde todos os dados serão colocados em escala logaritmica com base em um parametro lambda. O melhor valor para esse parametro é aquele que busca deixar o padrão da sazonalidade da serie praticamente a mesma, isso simplificará a série e fará com que as futuras previsões feitas sejam menos sensiveis a pontos flutuantes. Para estimar o valor de lambda utilizei o recurso guerrero, ele escolhe o melhor valor para lambda automaticamente e logo em seguida plotei a série ajustada.

lambda <- serie %>%
  features(Suicidios, features=guerrero) %>%
  pull(lambda_guerrero)

serie %>%
  autoplot(box_cox(Suicidios, lambda)) + 
           labs(title="Serie ajustada",
           y="Suicídios/população") + theme_bw()

#Colocando uma coluna dos valores em log

Decidir optar pela decomposição aditiva, onde y(t)= S(t) + T(t) + R(t) pois o comportamento da serie não varia ao longo do tempo em relação a sua sazonalidade e tendência. Foi escolhido o método STL para fazer a decomposição opr ele ser o mais utilizado por diversos motivos como ser mais robusto a outline e poder lidar com qualquer tipo de sazonalidade. Definir o ciclo de tendência variando a cada 24 Meses e uma sazonalidade padrão ao longo dos anos.

serie %>%
  model(STL(box_cox(Suicidios,lambda)~season(window="periodic")+trend(window=24),robust=TRUE)) %>%
  components() %>%
  autoplot() + theme_bw()

A serie histórica mostra uma forte tendência de crescimento, mas uma baixa sazonalidade sendo seu componente remanescente mostrando que existem variáveis externas que possam estar influênciando os número de suícidios.

Para finalizar decidir encontrar a força da tendência e da sazonalidade.

serie %>%
  features(Suicidios, feat_stl) %>%
  select(c("trend_strength", "seasonal_strength_year"))

A série histórica possui uma alta força de tendência e uma força média de sazonalidade

Outros Recursos

Calculei a entropia espectral (Shannon) que é uma medidade que mostra quão fácil é prever os proximos valores dessa série. Quanto mais próxima de 0 mais fácil será a previsão, o valor para a série estudada deu 0.10, mostrando que é uma série fácil de prever.

serie %>%
  features(Suicidios,feat_spectral)

Escolhendo Modelo de Series temporais

Método de Suavização Exponêncial

Como primeira opção de modelo escolhi o método de suavização exponencial (ETS), para usarmos esse tipo de abordagem é necessário estimar os parametros para o erro (Aditivo ou Multiplicativo), tendência(Nenhuma,Aditiva,Aditiva amortecida) e a sazonalidade(Nenhuma, Atiditivo ou Multiplicativo). Para encontrar esses parametros utilizei a função do R ets() que utiliza o critério de AICa para encontrar um modelo apropriado de forma automatica

fit<-serie %>%
  model(ETS(Suicidios))
report(fit)

## Series: Suicidios 
## Model: ETS(M,Ad,M) 
##   Smoothing parameters:
##     alpha = 0.29069 
##     beta  = 0.005560979 
##     gamma = 0.0001049667 
##     phi   = 0.9714889 
## 
##   Initial states:
##         l        b      s1        s2       s3        s4       s5        s6
##  550.9013 1.779263 1.05667 0.9973694 1.033154 0.9941494 1.000316 0.9363775
##         s7        s8        s9      s10       s11      s12
##  0.9242413 0.9773794 0.9895966 1.056725 0.9703554 1.063666
## 
##   sigma^2:  0.0021
## 
##      AIC     AICc      BIC 
## 3692.164 3694.706 3758.097

O método escolhido foi o ETS(M,Ad,M).

Inicialmente dividir os dados de treino e teste

# Separando dados em treino e teste
treino=dados[dados$Ano<=2017,c("Mes","Suicidios")] %>%
  as_tsibble(index = Mes)

teste= dados[dados$Ano>2017,c("Mes","Suicidios")] %>%
  as_tsibble(index = Mes)


#Criando um fit do metodo ETS
treino_fit <- treino %>%
  model(Previsao=ETS(Suicidios))

#Prevendo os proximos 24 meses
previsao = treino_fit %>%
  forecast(h=24)

Visualizando os resultados

autoplot(treino, .vars = Suicidios, color="black") +
  autolayer(teste, .vars=Suicidios, color="black") + theme_bw()+
  autolayer(previsao, level=NULL, color="red") + 
  labs(title = "Previsão da Serie histórica para os próximos 2 Anos", y="Suicidios/100k", subtitle = "2018 Jan - 2019 Dez") + guides(colour= guide_legend(title = "Forecast", label = TRUE))

Avaliando apenas o intervalo de previsão

prev= cbind(previsao$.mean, teste)  
names(prev)<- c("Previsto","Periodo","Real")

ggplot(prev, aes(x=Periodo,y=Real, color="black")) + geom_line() + geom_line(aes(x=Periodo, y=Previsto, color="red")) + theme_bw() + labs(title = "Valores reais e valores previstos ",y="Suicidios/100k", subtitle = "Periodo:2018 Jan - 2019 Dez") + guides(colour=guide_legend(title="Series")) + 
  scale_color_manual(labels = c("Real", "Previsto"), values = c("black", "red"))

autoplot(previsao) + 
  autolayer(teste,.vars=Suicidios) + theme_bw()

Metodo Arima

Estacionariedade da Serie

Olhando a serie ao longo do tempo é possível perceber que ela é não estacionária pois seus valores dependem do tempo (Tendência e Sazonalidade). Nessa secção tornarei a serie estacionária, para finalmente utilizar o método Arima.

Será utilizado o teste de raiz unitária, são testes de hipótese que podem ser utilizados para avaliar objetivamente se uma série temporal é estacionária ou não. Existem diversos testes diferentes, para essa análise escolhi o teste Kwiatkowski-Phillips-Schmidt-Shin.

Para esse teste, temos como a hipótese nula que a série é estacionária e a hipotese alternativa de que a série não é estacionária. Será definido o valor de p=0.01

# Colocando uma coluna de log
treino %>%
  features(Suicidios, unitroot_kpss)

A estatistica de testes (4.28) é maior que o valor crítico de 0.01, logo a hipótese nula é rejeitada.

Sabendo disso, é necessário transformar a série em uma série estaciónaria.

Diferenciação ordinária e diferenciação ordinal

Existem duas formas de tratar uma serie não-estacionária:

Diferenciação ordinária: É calculado as diferenças entre as observações consecutivas

-Diferenciação sazonal: É calculado as diferenças entre as observações de um ano para outro.

Segundo o livro FPP3, deve-se escolher inicialmente a diferenciação sazonal se a força sazonal da série for menor que 0.64 nenhuma diferenciação sazonal é sugerida. Anteriormente mostrei que a força sazonal dessa série é de 0.61, devido a isso utilizarei a diferencição ordinária como primeira opção para transformar a série.

Existe uma função no R chamana unitroot_ndiffs() que utiliza os testes KPSS para determinar o número apropriado de diferenças ordinarias a serem utilizados

treino %>%
  features(Suicidios, unitroot_ndiffs)

Como mostrado acima, apenas uma diferença é necessária para transformar os dados em estácionários

treino_arima=treino %>%
  mutate(log_suicidios=log(Suicidios)) %>%
  mutate(dif_suicidios= difference(log(Suicidios)))
?difference

## starting httpd help server ... done

Utilizando o teste de Kwiatkowski-Phillips-Schmidt-Shin para um valor p=0.01 para a série transformada:

treino_arima %>%
  features(dif_suicidios, unitroot_kpss)

Com um valor para o teste de (0.0227), não podemos recusar a hipotese nula de que a série é estacionária. Abaixo segue um plot mostrando as diferentes transformações e as novas séries que foram geradas

treino_arima %>%
  pivot_longer(-Mes,names_to="Type",values_to="Series")%>%
  mutate(
    Type= factor(Type, levels = c("Suicidios",
                                  "log_suicidios",
                                  "dif_suicidios"))
  ) %>%
  ggplot(aes(x=Mes, y=Series)) + geom_line()+
  facet_grid(vars(Type), scales="free_y") + labs(title = "Série História taxa de suícidio no Brasil ", subtitle = "Periodo: 1996 jan - 2017 Dez") + theme_bw()

Método ARIMA

fit_arima=treino_arima %>%
  model(ARIMA(Suicidios))
report(fit_arima)

## Series: Suicidios 
## Model: ARIMA(0,1,3)(0,0,2)[12] w/ drift 
## 
## Coefficients:
##           ma1     ma2      ma3    sma1    sma2  constant
##       -0.7357  0.1067  -0.2743  0.3833  0.2082    1.9275
## s.e.   0.0610  0.0695   0.0665  0.0665  0.0558    0.4161
## 
## sigma^2 estimated as 1797:  log likelihood=-1357.36
## AIC=2728.72   AICc=2729.16   BIC=2753.72

fit_arima %>%
  forecast(h=24) %>%
  autoplot(teste)

rbind(accuracy(fit_arima), accuracy(fit))

ProjetoSuicidio

Italo Iveldo

15/07/2020

Introdução

Estrutura do Trabalho

Etapa 1: Análise do panorama geral no mundo

Etapa 2: Análise de Dados do brasil com base no SUS

Etapa 3: Séries Temporais e previsão

Etapa 1: Análise do panorama geral no mundo

Objetivo: Analisar dados referêntes a taxa de suicídio e obter insigths a partir de algumas hipóteses

Descrição

Dicionario dos dados

Análise exploratória dos dados

Tratamento de dados

Analise descritiva dos dados

Analise Exploratoria nível de País

Ao passar dos anos, qual foi a quantidade de suicídios ?

Qual faixa etária que tem mais suicídios no mundo ? Crianças, adolescentes, adultos ou idosos ?

Qual métrica utilizar, por 100k ou total ?

Se suicidam mais pessoas do sexo masculino ou feminino ?

Será que o padrão de homens se suicidarem mais que mulheres seguem esse padrão para todas as faixas etarias ?

Quais os países que mais pessoas suicidam ?

Qual a geração que mais se suicidou ? Talvez tire

Como se dar os suícidios pela renda das pessoas

Pré Processamento da da base de dados

Bibliotecas

Tratando os os dados relacionado aos obitos por sexo

Tratando dados Relacionados a Cor

Tratando dados Relacionados a Cor padrão IBGE

Tratando dados Relacionados a suicidio por Local

Tratamento Dados Relacionados a suicidio por Faixa Etaria

Tratamento Dados Relacionados a suicidio por Estado Civil

Tratamento de Dados Relacionado a suicidio por Tipo de Causa

Tratamento de dados relacionado a suicidio por cor e idade

Tratando dados relacionados a suicidio por cor e idade pelo padrão IBGE

Analise Descritiva dos dados

Suicidio Por estado

Suicidios Por Causas no geral e para cada sexo

SUicidio por cor

Suicidio por Sexo

Graficos relacionado ao estado civil

Gráfico de local

Parte 3- Serie Temporal (Prevendo valores de Suicidio)

Grafico de tempo

Parcelas Sazonais

Gráfico de Subséries Temporais

Avaliando possíveis series temporais que possam ter ligação com o número de suicídios

Indice de Desenvolvimento Humando (IDH)

Decomposição da série temporal

Transformaçao e ajuste

Outros Recursos

Escolhendo Modelo de Series temporais

Método de Suavização Exponêncial

Metodo Arima

Estacionariedade da Serie

Diferenciação ordinária e diferenciação ordinal

Método ARIMA