Análise quantitativa do survey do StackOverflow

O objetivo deste notebook é apresentar análises feitas a partir do survey do StackOverflow realizado em 2022 sobre profissionais com deficiência e tentar relacionar a presença da deficiência com outras variáveis, sejam elas numéricas ou categóricas

library(tidyr)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)
library(gapminder)
library(forcats)
library(gcookbook)
library(reshape2)
## 
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
## 
##     smiths
# Arquivos
caminho_arquivo_2022 <- "C:/Users/s701257454/Documents/Mestrado/Data/2022/2022_survey_results_public.csv"
caminho_arquivo_2021 <- "C:/Users/s701257454/Documents/Mestrado/Data/2021/2021_survey_results_public.csv"

# Dados
dados_2022 <- read.csv(caminho_arquivo_2022)
dados_2021 <- read.csv(caminho_arquivo_2021)

VISUAL <- "I am blind / have difficulty seeing"
AUDITIVA <- "I am deaf / hard of hearing"
MOTORA <- "I am unable to / find it difficult to type"
LOCOMOCAO <- "I am unable to / find it difficult to walk or stand without assistance"
OUTROS <- "None of the above"

valores <- c(VISUAL,AUDITIVA,MOTORA,LOCOMOCAO)
valores_com_excecao <- c(VISUAL,AUDITIVA,MOTORA,LOCOMOCAO,OUTROS)

# Colunas a serem observadas
coluna_deficiencia <- "Accessibility"
coluna_status_atual <- "MainBranch"
coluna_emprego_atual <- "Employment"
coluna_trabalho_remoto <- "RemoteWork"
coluna_nivel_educacao <- "EdLevel"
coluna_tipo_educacao <- "LearnCode"
coluna_tempo_programacao <- "YearsCode"
coluna_tempo_programacao_pro <- "YearsCodePro"
coluna_tamanho_organizacao <- "OrgSize"
coluna_influencia <- "PurchaseInfluence"
coluna_pais <- "Country"
coluna_idade <- "Age"
coluna_saude_mental <- "MentalHealth"

# Dados observados
dados_filtrados_2022 <- dados_2022[!is.na(dados_2022[[coluna_deficiencia]]) & dados_2022[[coluna_deficiencia]] %in% valores, ]

dados_filtrados_com_excecao_2022 <- dados_2022[!is.na(dados_2022[[coluna_deficiencia]]) & dados_2022[[coluna_deficiencia]] %in% valores_com_excecao, ]

dados_filtrados_2021 <- dados_2021[!is.na(dados_2021[[coluna_deficiencia]]) & dados_2021[[coluna_deficiencia]] %in% valores, ]

# Dados de controle
dados_controle_2022 <- dados_2022[is.na(dados_2022[[coluna_deficiencia]]) | dados_2022[[coluna_deficiencia]] %in% c(OUTROS), ]
dados_controle_2021 <- dados_2021[is.na(dados_2021[[coluna_deficiencia]]) | dados_2021[[coluna_deficiencia]] %in% c(OUTROS), ]

# Definir a função para gráfico de barras
plot_contagem_porcentagem_cores <- function(dados, coluna, tipo) {
  # Remover os valores nulos da coluna especificada
  dados_sem_nulos <- dados[!is.na(dados[[coluna]]), ]
  
  # Dividir as respostas separadas por ponto e vírgula em elementos individuais
  dados_divididos <- strsplit(as.character(dados_sem_nulos[[coluna]]), ";")
  respostas <- unlist(dados_divididos)
  
  # Contar as ocorrências de cada valor único na coluna especificada
  contagem <- table(respostas)
  
  # Calcular as porcentagens
  porcentagens <- prop.table(contagem) * 100
  
  # Converter os resultados em um data frame
  contagem_df <- data.frame(valor = names(contagem), frequencia = as.numeric(contagem), porcentagem = porcentagens)
  
  # Definir uma paleta de cores em tons pasteis
  cores <- scales::brewer_pal(palette = "Pastel1")(length(unique(contagem_df$valor)))
  
  # Criar o gráfico de barras com texto das frequências em porcentagem acima das barras
  grafico <- ggplot(contagem_df, aes(x = valor, y = frequencia, fill = valor, label = paste0(round(porcentagens, 2), "%"))) +
    geom_bar(stat = "identity") +
    geom_text(size = 3, position = position_stack(vjust = 0.5), color = "black") +
    labs(x = coluna, y = "Frequency", title = paste(tipo, "- Occurrence counts of", coluna)) +
    theme(axis.text.x = element_blank(),  # Remover rótulos do eixo x
          axis.ticks.x = element_blank()) +  # Remover marcas do eixo x
    scale_fill_manual(name = NULL, values = cores)  # Remover o título da legenda
  
  # Retorna o gráfico
  return(grafico)
}

# Definir a função para correlograma
plot_correlograma <- function(dados, variavel1, variavel2, var1_name = "Tipo de Deficiência", var2_name = "Neurodivergente") {
  
  # Calcular as frequências de cada combinação de variáveis
  freq_comb <- table(dados[[variavel1]], dados[[variavel2]])
  
  # Calcular as frequências marginais de var1
  freq_var1 <- margin.table(freq_comb, 1)
  
  # Calcular as porcentagens
  perc <- prop.table(freq_comb, margin = 1) * 100
  
  # Converter em dataframe
  df_perc <- as.data.frame(perc)
  
  # Adicionar a frequência total de cada categoria da var1
  df_perc$Freq_Var1 <- freq_var1[rownames(df_perc)]
  
  # Ajustar nomes das colunas
  colnames(df_perc) <- c(var1_name, var2_name, "Porcentagem", "Freq_Var1")
  
  # Definir cores em tons pasteis
  cores <- scales::brewer_pal(palette = "Pastel1")(length(unique(dados[[variavel2]])))
  
  # Criar o gráfico de barras
  p <- ggplot(df_perc, aes(x = !!sym(var1_name), y = Porcentagem, fill = !!sym(var2_name))) +
    geom_bar(stat = "identity", position = "fill") +
    geom_text(aes(label = paste0(round(Porcentagem, 1), "%")),
              position = position_fill(vjust = 0.5), size = 3) +
    labs(x = "Type of disability", y = "Relative frequency", fill = var2_name) +
    ggtitle("Neurodivergent by Disability") +
    scale_fill_manual(name = NULL, values = cores) +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  
  return(p)
}

transformar_tabela <- function(tabela, TA, TB) {
  nova_tabela <- select(tabela, TA, TB)
  # Dividir os valores separados por ponto e vírgula em elementos individuais
  nova_tabela %>% 
    separate_rows(TA, TB, sep = ";")
  # Retornar o novo dataframe
  return(nova_tabela)
}

Amostragem de Pessoas com Defiência

O nosso grupo observacional será o conjunto de pessoas com deficiência, enquanto o nosso grupo de controle será o conjunto de pessoas que não declararam possuir alguma deficiência. O gráfico a seguir apresenta o tipo de deficiência e seu respectivo percentual em relação ao nosso grupo observacional:

plot_contagem_porcentagem_cores(dados_filtrados_2022, coluna_deficiencia, "Observation Group - 2022")

Ocupação atual

Os gráficos a seguir apresentam os tipos de ocupações e suas respectivas porcentagens em relação ao nosso grupo observacional e o nosso grupo de controle:

plot_contagem_porcentagem_cores(dados_filtrados_2022, coluna_status_atual, "Observation Group - 2022")

plot_contagem_porcentagem_cores(dados_controle_2022, coluna_status_atual, "Control Group - 2022")

Emprego atual

Os gráficos a seguir apresentam os tipos de emprego e suas respectivas porcentagens em relação ao nosso grupo observacional e o nosso grupo de controle:

plot_contagem_porcentagem_cores(dados_filtrados_2022, coluna_emprego_atual, "Observation Group - 2022")

plot_contagem_porcentagem_cores(dados_controle_2022, coluna_emprego_atual, "Control Group - 2022")

Trabalho Remoto

Os gráficos a seguir apresentam os tipos de trabalho remoto e suas respectivas porcentagens em relação ao nosso grupo observacional e o nosso grupo de controle:

plot_contagem_porcentagem_cores(dados_filtrados_2022, coluna_trabalho_remoto, "Observation Group - 2022")

plot_contagem_porcentagem_cores(dados_controle_2022, coluna_trabalho_remoto, "Control Group - 2022")

Nível de educação

Os gráficos a seguir apresentam os tipos de níveis de educação e suas respectivas porcentagens em relação ao nosso grupo observacional e o nosso grupo de controle:

plot_contagem_porcentagem_cores(dados_filtrados_2022, coluna_nivel_educacao, "Observation Group - 2022")

plot_contagem_porcentagem_cores(dados_controle_2022, coluna_nivel_educacao, "Control Group - 2022")

Idade

Os gráficos a seguir apresentam os tipos de faixa etária e suas respectivas porcentagens em relação ao nosso grupo observacional e o nosso grupo de controle:

plot_contagem_porcentagem_cores(dados_filtrados_2022, coluna_idade, "Observation Group - 2022")

plot_contagem_porcentagem_cores(dados_controle_2022, coluna_idade, "Control Group - 2022")

Presença de neurodivergência

Os gráficos a seguir apresentam os tipos de neurodivergência e suas respectivas porcentagens em relação ao nosso grupo observacional e o nosso grupo de controle:

plot_contagem_porcentagem_cores(dados_filtrados_2022, coluna_saude_mental, "Observation Group - 2022")

plot_contagem_porcentagem_cores(dados_controle_2022, coluna_saude_mental, "Control Group - 2022")

### Matriz de Coocorrência
dados_normalizados <- transformar_tabela(dados_filtrados_com_excecao_2022, coluna_deficiencia, coluna_saude_mental)
## Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
##   # Was:
##   data %>% select(TA)
## 
##   # Now:
##   data %>% select(all_of(TA))
## 
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
##   # Was:
##   data %>% select(TB)
## 
##   # Now:
##   data %>% select(all_of(TB))
## 
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
s <- strsplit(dados_normalizados$MentalHealth, split = ";")
novo_dataframe <- data.frame(Accessibility = rep(dados_normalizados$Accessibility, sapply(s, length)), MentalHealth = unlist(s))

matriz_coocorrencia <- function(dados, var1, var2) {
  # Calcular a matriz de contingência
  matriz <- table(dados[[var1]], dados[[var2]])
  return(matriz)
}
# Função para criar um heatmap da matriz de coocorrência
heatmap_coocorrencia <- function(matriz_coocorrencia, var1_name = "Variável 1", var2_name = "Variável 2") {
  # Calcular o total de observações
  total_obs <- sum(matriz_coocorrencia)
  
  # Calcular a matriz de coocorrência em percentuais
  matriz_percentual <- matriz_coocorrencia / total_obs * 100
  
  # Converter a matriz em um dataframe
  df <- as.data.frame(matriz_percentual)
  
  # Converter o dataframe para o formato longo
  df_long <- melt(df)
  
  # Criar o heatmap
  p <- ggplot(df_long, aes(x = Var2, y = Var1, fill = value)) +
    geom_tile(color = "white") +
    geom_text(aes(label = paste0(round(value, 1), "%")), color = "black") +
    scale_fill_gradient(low = "white", high = "steelblue", limits = c(0, max(df_long$value)),
                        breaks = NULL) +
    labs(x = var2_name, y = var1_name, title = "Matriz de Coocorrência (%)") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1),
          axis.title = element_text(size = 12),
          plot.title = element_text(hjust = 0.5))
  
  return(p)
}

dados_filtrados_correlograma <- novo_dataframe[!is.na(novo_dataframe[[coluna_deficiencia]]) & novo_dataframe[[coluna_deficiencia]] %in% valores, ]
dados_controle_correlograma <- novo_dataframe[!is.na(novo_dataframe[[coluna_deficiencia]]) & !novo_dataframe[[coluna_deficiencia]] %in% valores, ]

matriz_coocorrencia_deficiencia_neurodivergencia <- matriz_coocorrencia(dados_filtrados_correlograma, coluna_deficiencia, coluna_saude_mental)

print(heatmap_coocorrencia(matriz_coocorrencia_deficiencia_neurodivergencia, coluna_deficiencia, coluna_saude_mental))
## Using Var1, Var2 as id variables

matriz_coocorrencia_deficiencia_neurodivergencia_c <- matriz_coocorrencia(novo_dataframe, coluna_deficiencia, coluna_saude_mental)

Salário

O box plot a seguir mostra a distribuição de salários das pessoas que não apresentam deficiência e, ao lado, das pessoas com deficiência:

### Adiciona coluna para constatar deficiência
dados_2022_dis_coluna <- dados_2022 %>%
  mutate(has_disability = case_when(
    Accessibility %in% valores ~ "Y",
    TRUE ~ "N"
  ))

### Adiciona salario
dados_2022_dis_coluna_sal <- dados_2022_dis_coluna %>%
  mutate(salary = case_when(
    CompFreq == "Yearly" ~ CompTotal,
    CompFreq == "Monthly" ~ CompTotal,
    CompFreq == "Weekly" ~ CompTotal,
  ))


dados_2022_dis_coluna_sal_without_na <- dados_2022_dis_coluna_sal[!is.na(dados_2022_dis_coluna_sal$salary) & as.numeric(dados_2022_dis_coluna_sal$salary) <= 1000000,]

salary_disability <- dados_2022_dis_coluna_sal_without_na %>% 
  group_by(has_disability) %>% 
  summarise(mens_media = mean(salary),
            mens_max = max(salary),
            mens_median = median(salary))

boxplot_relacionado <- function(dados, categoria, valor_numerico, categoria1, categoria2) {
  # Criar o gráfico de boxplot
  p <- ggplot(dados, aes_string(x = categoria, y = valor_numerico, fill = categoria)) +
    geom_boxplot(width = 0.5) +
    labs(x = categoria, y = "Salary", fill = categoria) +
    scale_fill_manual(values = c("N" = "lightblue", "Y" = "lightgreen")) +
    theme_minimal()
  
  return(p)
}

print(boxplot_relacionado(dados_2022_dis_coluna_sal_without_na, "has_disability", "salary", "Y", "N"))
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.