Gun Violence Data Analysis
knitr::opts_chunk$set(echo = TRUE)
library(readr) # Leitura de dados## Warning: package 'readr' was built under R version 4.3.2library(dplyr) # Manipulação de dados (filtragem, seleção, agregação, etc.)## Warning: package 'dplyr' was built under R version 4.3.2##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(maps) # Dados de mapas para plotagem## Warning: package 'maps' was built under R version 4.3.2library(ggplot2) # Criação de gráficos## Warning: package 'ggplot2' was built under R version 4.3.2library(tidyr) # Manipulação de dados (transformação entre formatos wide e long)## Warning: package 'tidyr' was built under R version 4.3.2library(tidyverse) # Conjunto de pacotes (incluindo dplyr, ggplot2, tidyr) para análise de dados## Warning: package 'tidyverse' was built under R version 4.3.2## Warning: package 'tibble' was built under R version 4.3.2## Warning: package 'purrr' was built under R version 4.3.2## Warning: package 'stringr' was built under R version 4.3.2## Warning: package 'forcats' was built under R version 4.3.2## Warning: package 'lubridate' was built under R version 4.3.2## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ purrr::map() masks maps::map()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsIntrodução
1.1 Declaração do Problema
Neste estudo, abordaremos a problemática da violência armada nos Estados Unidos e sua possível correlação com os períodos eleitorais presidenciais. A relevância deste estudo decorre da necessidade de maximizar a eficiência na distribuição dos efetivos policiais durante as eleições de 2024, um evento que exige segurança reforçada. É preciso entender se os índices de violência armada podem ajudar a prever tensões durante as eleições, justificando o interesse de diversas partes, desde órgãos de segurança pública até cidadãos preocupados com a integridade do processo eleitoral.
1.2 Abordagem Metodológica
Para investigar esta questão, utilizaremos dados históricos de violência armada, incluindo a frequência e localização dos incidentes, e os concatenaremos com os dados de votação presidencial por estado. Através de análises, buscaremos padrões e correlações que possam indicar quais estados apresentam maior risco de incidentes durante os períodos eleitorais, baseando-se em tendências históricas de violência e preferências políticas.
1.3 Abordagem Técnica Proposta
A análise será conduzida através de técnicas de mineração de dados e modelos preditivos, tais como regressão linear e algoritmos de classificação. Estas técnicas permitirão estimar a probabilidade de incidentes de violência armada em diferentes estados, considerando variáveis como resultados eleitorais anteriores e taxas históricas de violência. A análise será executada utilizando o software R, uma ferramenta poderosa para computação estatística e gráficos.
1.4 Benefícios da Análise
A conclusão desta análise oferecerá à polícia uma ferramenta valiosa para alocar seus recursos de maneira mais eficaz, especialmente em estados onde a análise indicar maiores riscos. Isso não apenas otimizará a distribuição de pessoal e recursos, mas também contribuirá para a segurança e integridade do processo eleitoral, beneficiando todos os envolvidos.
Preparação dos Dados
3.1 Fonte dos Dados
Os dados de violência armada foram obtidos do site Kaggle. Assim como os dados eleitorais. Estes conjuntos de dados são fundamentais para a análise, pois fornecem uma visão ampla dos incidentes de violência armada e do comportamento eleitoral nos EUA ao longo dos anos.
3.2 Descrição Detalhada dos Dados
O conjunto de dados de violência armada foi coletado com o propósito de demonstrar eventos isolados de violencia envolvendo armas entre os anos de 2013 até 2018. Contém 29 variáveis, porem muitas não serão utilizadas devido a não necessidade do projeto, das que serão mais utilizxadas temos cidade, estado onde ocorreram os atos, alem de informações dos envolvidos como idade, genero, estado de saúde, e se foram vitimas ou criminosos.
Os dados eleitorais foram coletados com o objetivo de mostrar qual a tendencia eleitoral histórica de cada estado dos EUA, possibilitando a comparação dos dados de violencia em cada estado. Inclui 15 variaveis, algumas redundantes como office e state_flip/cen/ic e alguns dados possuem um nivel de detalhe acima do necessario para nossa analise, como o nome dos partidos de cada candidato, vamos focar apenas em que spectro o candidato se encontra: Democrata, Republicano ou Outro.focaremos nos dados de estado, partido, e porcentagem de votos
Ambos os conjuntos de dados foram examinados quanto a peculiaridades como valores ausentes, que foram registrados como vazios, em outros casos os dados estão em formatos não convencionais, que serão convertidos para formatos utilizaveis.
3.3 Importação e Limpeza dos Dados
# Importação dos dados, transformando valores invalidos em NA
data <- read_csv("./R/data/gun-violence.csv")## Rows: 239677 Columns: 29
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (18): state, city_or_county, address, incident_url, source_url, gun_sto...
## dbl (9): incident_id, n_killed, n_injured, congressional_district, latitud...
## lgl (1): incident_url_fields_missing
## date (1): date
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# selecionando as colunas a serem utilizadas
gun_violence <- data %>%
select(date, state, incident_id, n_killed, n_injured, state,participant_age, participant_status,participant_gender)
# Função para transformar as colunas com formato index::key em uma lista analisavel
transform_column <- function(column) {
lapply(column, function(x) {
if (is.na(x)) return(NA)
parts <- strsplit(x, "\\|\\|", fixed = TRUE)[[1]]
lapply(parts, function(part) {
pieces <- strsplit(part, "::", fixed = TRUE)[[1]]
if (length(pieces) < 2) return(NULL)
list(id = as.integer(pieces[1]), value = pieces[2])
})
})
}
# Aplicar a transformação
gun_violence$transformed_participant_age <- transform_column(gun_violence$participant_age)
gun_violence$transformed_participant_status <- transform_column(gun_violence$participant_status)
# removendo casos com idades muito descrepantes
filter_outliers <- function(ages_column) {
indices_to_keep <- sapply(ages_column, function(ages_list) {
if (is.null(ages_list)) return(TRUE) # Se for NULL, mantenha o evento
# Itera sobre cada lista de idades dentro do evento
all_ages_valid <- TRUE
for(age_info in ages_list) {
# Garantir que age_info é uma lista e tem um campo 'value'
if (!is.list(age_info) || is.null(age_info$value)) next
# Verifica se o valor é um número antes de converter
if (grepl("^[0-9]+$", age_info$value)) {
age_value <- as.numeric(age_info$value)
# Se age_value for maior que 100, marcar como inválido e sair do loop
if (age_value > 100) {
all_ages_valid <- FALSE
break
}
} else {
# Se não for um número, introduza NA e trate como inválido
all_ages_valid <- FALSE
break
}
}
return(all_ages_valid) # Retorna TRUE se todas as idades são válidas, FALSE caso contrário
})
return(indices_to_keep)
}
# Aplicar a função de filtragem
indices_to_keep <- filter_outliers(gun_violence$transformed_participant_age)
gun_violence_filtered <- gun_violence[indices_to_keep, ]
glimpse(gun_violence_filtered)## Rows: 190,033
## Columns: 10
## $ date <date> 2013-01-01, 2013-01-01, 2013-01-21, 20…
## $ state <chr> "Pennsylvania", "California", "Louisian…
## $ incident_id <dbl> 461105, 460726, 479374, 479389, 492151,…
## $ n_killed <dbl> 0, 1, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, …
## $ n_injured <dbl> 4, 3, 5, 4, 6, 3, 3, 5, 5, 4, 4, 8, 4, …
## $ participant_age <chr> "0::20", "0::20", NA, NA, "0::15", "0::…
## $ participant_status <chr> "0::Arrested||1::Injured||2::Injured||3…
## $ participant_gender <chr> "0::Male||1::Male||3::Male||4::Female",…
## $ transformed_participant_age <list> [[0, "20"]], [[0, "20"]], NA, NA, [[0,…
## $ transformed_participant_status <list> [[0, "Arrested||1"]], [[0, "Killed||1"…Os dados pos tranformações aparentam estar bem similares, a maior diferença é a remoção de algumas entradas com idades maiores que 100 anos, alem da mudança de formato entre das colunas relacionadas aos participantes
# importando dataset e selecionando apenas colunas de interesse
president_elections <- read.csv("./R/data/president.csv")
dados_eleicoes <- president_elections %>%
select(state, year,candidatevotes,totalvotes,party_simplified)Não foi necessaria a limpeza dos dados das eleições, apenas a seleção de colunas especificas
Análise Exploratoria
Estados mais letais
# Preparar os dados de mapa
estados_mapa <- map_data("state")
estados_mapa$region <- tolower(estados_mapa$region) # Converter os nomes dos estados em mapa para minúsculas para correspondência
gun_violence_with_deaths <- gun_violence_filtered %>%
filter(n_killed > 0)
# Processar os dados para contar ocorrências por estado
ocorrencias_por_estado <- gun_violence_with_deaths %>%
group_by(state) %>%
summarise(Ocorrencias = n()) %>%
ungroup() %>%
mutate(Estado = tolower(state))
# Juntar o número de ocorrências com os dados do mapa
dados_para_plot <- merge(estados_mapa, ocorrencias_por_estado, by.x = "region", by.y = "Estado", all.x = TRUE)
# Tratar possíveis estados não correspondidos ou dados faltantes
dados_para_plot$Ocorrencias[is.na(dados_para_plot$Ocorrencias)] <- 0
# Criar o plot
ggplot(dados_para_plot, aes(x = long, y = lat, group = group, fill = Ocorrencias)) +
geom_polygon(color = "grey") +
expand_limits(x = dados_para_plot$long, y = dados_para_plot$lat) +
scale_fill_gradient(low = "#F0F0Ff", high = "red", name = "Ocorrencias") +
labs(title = "Ocorrencias letais por Estado nos EUA", x = "", y = "") +
theme_minimal() +
theme(axis.text = element_blank(), axis.ticks = element_blank(), panel.grid = element_blank())
### Idade com Maior mortalidade
# Função para extrair idades dos participantes mortos
extract_ages_of_deceased <- function(ages, statuses) {
map2(ages, statuses, ~{
if (is.na(.x) | is.na(.y)) return(NA)
age_list <- .x
status_list <- .y
# Criar vetores apenas com os status e idades dos participantes mortos
deceased_statuses <- map(status_list, ~ .x$value) %>% unlist() %>% str_detect("Killed")
if (any(deceased_statuses)) {
deceased_ages <- map(age_list[deceased_statuses], ~ .x$value) %>% unlist() %>% as.numeric()
} else {
deceased_ages <- numeric(0) # Retorna um vetor numérico vazio se não houver mortos
}
return(deceased_ages)
})
}
# Aplicar a função para extrair as idades
ages_of_deceased <- extract_ages_of_deceased(gun_violence_filtered$transformed_participant_age, gun_violence_filtered$transformed_participant_status)
# Descompactar a lista para ter um vetor com todas as idades dos mortos
all_ages_of_deceased <- unlist(ages_of_deceased, recursive = FALSE) %>% unlist() %>% na.omit()
# Criar um histograma com as idades dos mortos
ggplot(data.frame(Age = all_ages_of_deceased), aes(x = Age)) +
geom_histogram(binwidth = 1, fill = "darkred", color = "black") +
theme_minimal() +
labs(title = "Distribuição das Idades dos Mortos em Eventos de Violência Armada",
x = "Idade",
y = "Número de Mortos")
### Votos historicos para presidente
# Calcular a soma total de votos por estado e por ano
total_votes_by_state_year <- dados_eleicoes %>%
group_by(year, state) %>%
summarise(total_votes = sum(candidatevotes)) %>%
ungroup()## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.# Juntar a soma total de volta aos dados de eleição para calcular proporções
dados_eleicoes <- dados_eleicoes %>%
left_join(total_votes_by_state_year, by = c("year", "state"))
# Calcular a proporção de votos para cada partido por estado e por ano
dados_eleicoes <- dados_eleicoes %>%
mutate(vote_proportion = candidatevotes / total_votes)
# Agora, agrupar por estado e partido para calcular a proporção média de votos ao longo dos anos
average_proportion_by_party_state <- dados_eleicoes %>%
group_by(state, party_simplified) %>%
summarise(average_proportion = mean(vote_proportion, na.rm = TRUE)) %>%
spread(key = party_simplified, value = average_proportion, fill = 0) %>%
ungroup()## `summarise()` has grouped output by 'state'. You can override using the
## `.groups` argument.# Mapear as proporções para a escala RGB (0 a 255)
average_proportion_by_party_state <- average_proportion_by_party_state %>%
mutate(R = round(REPUBLICAN * 255),
G = round(OTHER * 255),
B = round(DEMOCRAT * 255),
color = rgb(R, G, B, maxColorValue = 255))
# Carregar os dados do mapa
map_data_usa <- map_data("state")
# Transformar os nomes dos estados para minúsculas para garantir a correspondência
average_proportion_by_party_state$state <- tolower(average_proportion_by_party_state$state)
map_data_usa$region <- tolower(map_data_usa$region)
# Unir os dados do mapa com as cores calculadas
map_data_colored <- merge(map_data_usa, average_proportion_by_party_state, by.x = "region", by.y = "state")
# Supondo que dados_eleicoes já esteja definido
calcular_peso <- function(ano, ano_limiar = 1990, base = 1.05) {
ifelse(ano <= ano_limiar,
1 + (ano - min(ano)) / (ano_limiar - min(ano)),
1 + (ano_limiar - min(ano)) / (ano_limiar - min(ano)) * base^(ano - ano_limiar)*2)
}
# Adicionando um peso baseado no ano, com anos mais recentes recebendo pesos maiores
dados_eleicoes <- dados_eleicoes %>%
mutate(weight = calcular_peso(year))
# Calculando proporções ponderadas usando os pesos
dados_eleicoes <- dados_eleicoes %>%
mutate(pondered_vote = vote_proportion * weight)
# Agora, calcular a média ponderada das proporções para cada partido por estado
average_pondered_proportion <- dados_eleicoes %>%
group_by(state, party_simplified) %>%
summarise(average_pondered_proportion = sum(pondered_vote) / sum(weight)) %>%
spread(key = party_simplified, value = average_pondered_proportion, fill = 0) %>%
ungroup()## `summarise()` has grouped output by 'state'. You can override using the
## `.groups` argument.# Mapear as proporções ponderadas para a escala RGB
average_pondered_proportion <- average_pondered_proportion %>%
mutate(R = round(REPUBLICAN * 255),
G = round(OTHER * 255),
B = round(DEMOCRAT * 255),
color = rgb(R, G, B, maxColorValue = 255))
# Carregar os dados do mapa
map_data_usa <- map_data("state")
# Transformar os nomes dos estados para minúsculas para garantir a correspondência
average_pondered_proportion$state <- tolower(average_pondered_proportion$state)
map_data_usa$region <- tolower(map_data_usa$region)
# Unir os dados do mapa com as cores calculadas
map_data_colored <- merge(map_data_usa, average_pondered_proportion, by.x = "region", by.y = "state")
# Plotar o mapa
ggplot() +
geom_polygon(data = map_data_colored, aes(x = long, y = lat, group = group, fill = color), color = "white") +
scale_fill_identity() + # Usar as cores como estão
labs(title = "Mapa dos EUA com Cores Baseadas nas Proporcoes de Votos dos Partidos") +
theme_void() # Remover elementos desnecessários do gráfico
### Tendência histórica eleitoral para cada estado, junto com sua
quantidade de incidentes fatais
library(dplyr)
# Supondo que 'dados_eleicoes' seja o nome do seu conjunto de dados de eleições
# Categorizar cada candidato em uma das categorias: democrata, republicano ou outro
dados_eleicoes <- dados_eleicoes %>%
mutate(Party_Category = case_when(
party_simplified == "DEMOCRAT" ~ "Democrata",
party_simplified == "REPUBLICAN" ~ "Republicano",
TRUE ~ "Outros"
))
# Agregar os votos totais para cada categoria em cada estado
votos_agregados <- dados_eleicoes %>%
group_by(state, Party_Category) %>%
summarise(Total_Votos = sum(candidatevotes))## `summarise()` has grouped output by 'state'. You can override using the
## `.groups` argument.# Criar um novo conjunto de dados com as informações agregadas
dados_agregados <- votos_agregados %>%
pivot_wider(names_from = Party_Category, values_from = Total_Votos)
gun_violence_totals <- gun_violence_with_deaths %>%
group_by(state) %>%
summarise(Total_Cases = n())
gun_violence_totals <- gun_violence_totals %>%
mutate(state = toupper(state))
dados_combinados <- inner_join(gun_violence_totals, dados_agregados, by = "state")
dados_combinados <- dados_combinados %>%
arrange(desc(Total_Cases))
print(dados_combinados)## # A tibble: 51 × 5
## state Total_Cases Democrata Outros Republicano
## <chr> <int> <int> <int> <int>
## 1 CALIFORNIA 3587 74290623 7504127 56805352
## 2 TEXAS 2536 34247189 3013667 44117621
## 3 FLORIDA 1933 35597207 2608036 38656563
## 4 ILLINOIS 1931 31832321 2543275 26186145
## 5 PENNSYLVANIA 1255 31219644 2568091 29704596
## 6 GEORGIA 1198 15806524 904902 17376438
## 7 OHIO 1163 27426393 2834984 29601665
## 8 MARYLAND 1127 14503638 1003582 10188079
## 9 MISSOURI 1126 13219677 1258354 14949078
## 10 LOUISIANA 1068 9323633 739760 11512263
## # ℹ 41 more rowsConclusões
podemos observar, analisando os graficos, que não ha uma forte conexão entre estados mais letais e seus candidatos historicos mais votados, alem disso podemos ver que poucos estados possuem uma forte predileção à um partido que se mantenha durante as decadas, para aprofundar este estudo, pode-se checar datasets de idade dos votantes em cada estado e concatenar isso com as taxas de crime armado nestas faixas de idade, porem ate o momento não é possível desenhar uma ligação concreta entre partidos mais votados e taxas maiores de criminalidade