Code
lgbtq <- read.csv("lgbtq_rights_by_country.csv", stringsAsFactors = FALSE)
pib <- read.csv("gdp.csv", stringsAsFactors = FALSE)Projeto da Disciplina - Estatística para Cientistas de Dados [26E1_2]
Aceitação de pessoas LGBTQIAPN+ vs PIB per Capita
Rpubs: https://rpubs.com/riquebaron/PDestatistica
1. Mostre através de prints que você tem acesso a uma plataforma RStudio (instalado localmente ou nuvem).
2. Escolha uma base de dados para realizar esse projeto.
Base de dados 1: LGBT+ rights worldwide (2025) Kaggle: https://www.kaggle.com/datasets/wilomentena/lgbt-rights-worldwide
Base de dados 2: Global GDP Dataset Kaggle: https://www.kaggle.com/datasets/asadullahcreative/global-gdp-explorer-2024-world-bank-un-data
3. Explique qual o motivo para a escolha dessa base e explique os resultados esperados através da análise.
Interesse pessoal para avaliação da situação mundial por país com relação aos direitos LGBTQAPN+ e a associação com o PIB per capita desses países. Esta escolha gera variáveis discretas, que apesar de não serem muito boas para a avaliação, respondem ao que eu preciso e servem para o projeto.
4. Carregue a base para o RStudio e comprove o carregamento tirando um print da tela com a base escolhida presente na área “Ambiente”/Enviroment. Detalhe como você realizou o carregamento dos dados.
5. Instale e carregue os pacotes de R necessários para sua análise (mostre o código necessário): tidyverse, ggplot, summarytools
Code
library(tidyverse)
library(summarytools)6. Escolha outros pacotes necessários, aponte sua necessidade e instale e carregue (mostrando o código necessário).
Code
library(readr)
library(ggplot2)
library(patchwork)
library(corrplot)
library(gt)7. Aplique uma função em R que seja útil para sua análise e mostre
Code
glimpse(lgbtq)Rows: 239
Columns: 8
$ Territory <chr> "Benin", "Burki…
$ Same.sex.sexual.activity <chr> "Yes", "Yes", "…
$ Recognition.of.same.sex.unions <chr> "No", "No", "No…
$ Same.sex.marriage <chr> "No", "No", "No…
$ Adoption.by.same.sex.couples <chr> "No", "No", "No…
$ LGBT.people.allowed.to.serve.openly.in.military. <chr> "Unknown", "Unk…
$ Anti.discrimination.laws.concerning.sexual.orientation <chr> "No", "No", "Ye…
$ Laws.concerning.gender.identity.expression <chr> "Unknown", "Unk…Code
glimpse(pib)Rows: 181
Columns: 8
$ X <int> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, …
$ Country <chr> "United States", "China", "Germany", "Japan", "Ind…
$ GDP..nominal..2023. <chr> "$27,720,700,000,000", "$17,794,800,000,000", "$4,…
$ GDP..abbrev.. <chr> "27.721 trillion", "17.795 trillion", "4.526 trill…
$ GDP.Growth <chr> "2.89%", "5.25%", "−0.27%", "1.68%", "8.15%", "0.3…
$ Population.2023 <int> 343477335, 1422584933, 84548231, 124370947, 143806…
$ GDP.per.capita <chr> "$80,706", "$12,509", "$53,528", "$33,806", "$2,48…
$ Share.of.World.GDP <chr> "26.11%", "16.76%", "4.26%", "3.96%", "3.36%", "3.…Code
pibpercapita <- pib %>%
select(Country, GDP.per.capita)
df <- lgbtq %>%
left_join(
pibpercapita,
by = join_by(Territory == Country),
unmatched="drop"
)Code
df <- df %>%
filter(!is.na(GDP.per.capita))Code
df_num <- df %>%
mutate(
Same.sex.sexual.activity = recode(Same.sex.sexual.activity, "Yes" = 1, "No" = 0, "Unknown" = NA_real_),
Recognition.of.same.sex.unions = recode(Recognition.of.same.sex.unions, "Yes" = 1, "No" = 0, "Unknown" = NA_real_),
Same.sex.marriage = recode(Same.sex.marriage, "Yes" = 1, "No" = 0, "Unknown" = NA_real_),
Adoption.by.same.sex.couples = recode(Adoption.by.same.sex.couples, "Yes" = 1, "No" = 0, "Unknown" = NA_real_),
LGBT.people.allowed.to.serve.openly.in.military. = recode(LGBT.people.allowed.to.serve.openly.in.military., "Yes" = 1, "No" = 0, "Unknown" = NA_real_),
Anti.discrimination.laws.concerning.sexual.orientation = recode(Anti.discrimination.laws.concerning.sexual.orientation, "Yes" = 1, "No" = 0, "Unknown" = NA_real_),
Laws.concerning.gender.identity.expression = recode(Laws.concerning.gender.identity.expression, "Yes" = 1, "No" = 0, "Unknown" = NA_real_)
) %>%
rename (Atividade = Same.sex.sexual.activity) %>%
rename (Uniao = Recognition.of.same.sex.unions) %>%
rename (Casamento = Same.sex.marriage) %>%
rename (Adocao = Adoption.by.same.sex.couples) %>%
rename (Militar = LGBT.people.allowed.to.serve.openly.in.military.) %>%
rename (LeisOrientacao = Anti.discrimination.laws.concerning.sexual.orientation) %>%
rename (LeisGenero = Laws.concerning.gender.identity.expression) %>%
rename (PIBpC = GDP.per.capita) %>%
mutate(
PIBpC = gsub("\\$", "", PIBpC),
PIBpC = gsub(",", "", PIBpC),
PIBpC = as.double(PIBpC)
) %>%
mutate(
Nota = rowSums(across(-c(Territory, PIBpC)), na.rm = TRUE)
) %>%
select(where(is.numeric))8. Escolha uma variável de seu banco de dados e calcule: a média para todos os eventos, o desvio padrão, os quantis: 25% e 75%
Code
df_num %>%
summarise(
media = mean(Nota, na.rm = TRUE),
desvio_padrao = sd(Nota, na.rm = TRUE),
q1 = quantile(Nota, 0.25, na.rm = TRUE),
q3 = quantile(Nota, 0.75, na.rm = TRUE)
) %>%
gt()| media | desvio_padrao | q1 | q3 |
|---|---|---|---|
| 2.916168 | 2.520789 | 1 | 5 |
Code
df_num %>%
summarise(
media = mean(PIBpC, na.rm = TRUE),
desvio_padrao = sd(PIBpC, na.rm = TRUE),
q1 = quantile(PIBpC, 0.25, na.rm = TRUE),
q3 = quantile(PIBpC, 0.75, na.rm = TRUE)
) %>%
gt()| media | desvio_padrao | q1 | q3 |
|---|---|---|---|
| 18124.39 | 23345.08 | 2455.5 | 23788 |
9. Utilizando o pacote summarytools (função descr), descreva estatisticamente a sua base de dados.
Code
descr(df_num)Descriptive Statistics
df_num
N: 167
Adocao Atividade Casamento LeisGenero LeisOrientacao Militar Nota
----------------- -------- ----------- ----------- ------------ ---------------- --------- --------
Mean 0.25 0.72 0.22 0.54 0.56 0.52 2.92
Std.Dev 0.43 0.45 0.41 0.50 0.50 0.50 2.52
Min 0.00 0.00 0.00 0.00 0.00 0.00 0.00
Q1 0.00 0.00 0.00 0.00 0.00 0.00 1.00
Median 0.00 1.00 0.00 1.00 1.00 1.00 2.00
Q3 0.00 1.00 0.00 1.00 1.00 1.00 5.00
Max 1.00 1.00 1.00 1.00 1.00 1.00 7.00
MAD 0.00 0.00 0.00 0.00 0.00 0.00 2.97
IQR 0.00 1.00 0.00 1.00 1.00 1.00 4.00
CV 1.74 0.62 1.91 0.92 0.89 0.97 0.86
Skewness 1.15 -1.00 1.37 -0.17 -0.23 -0.06 0.44
SE.Skewness 0.19 0.19 0.19 0.20 0.19 0.21 0.19
Kurtosis -0.67 -1.01 -0.12 -1.98 -1.96 -2.01 -1.22
N.Valid 165.00 167.00 167.00 153.00 167.00 130.00 167.00
N 167.00 167.00 167.00 167.00 167.00 167.00 167.00
Pct.Valid 98.80 100.00 100.00 91.62 100.00 77.84 100.00
Table: Table continues below
PIBpC Uniao
----------------- ----------- --------
Mean 18124.39 0.28
Std.Dev 23345.08 0.45
Min 193.00 0.00
Q1 2430.00 0.00
Median 8083.00 0.00
Q3 23804.00 1.00
Max 128936.00 1.00
MAD 9917.11 0.00
IQR 21332.50 1.00
CV 1.29 1.63
Skewness 2.06 1.00
SE.Skewness 0.19 0.19
Kurtosis 4.54 -1.01
N.Valid 167.00 167.00
N 167.00 167.00
Pct.Valid 100.00 100.0010. Escolha uma variável e crie um histograma. Justifique o número de bins usados. A distribuição dessa variável se aproxima de uma “normal”? Justifique.
Code
#Histograma
p1 <- df_num %>%
ggplot(aes(x = Nota)) +
geom_histogram(
aes(y = after_stat(density)),
binwidth = 1,
color = "lightblue",
fill = "blue") +
labs(
title = "Pontuação/ Direitos em Países",
x = "Pontuação total/ Nota",
y = "Frequência"
)
#QQ plot
p2 <- df_num %>%
ggplot(aes(sample = Nota)) +
stat_qq(size = 2) +
stat_qq_line(color = "red", linewidth = 1) +
theme_minimal() +
labs(
title = "Pontuação/ Direitos em Países",
x = "Quantis Teóricos (Normais)",
y = "Quantis Amostrais"
)
p1 + p2
Usei binwidth de 1 ponto visto que temos apenas possibilidades de 0 a 7 para notas. Poderia ter feito em cima do PIB per Capita, mas achei importante focar nas notas e trabalhar pessoalmente nestes detalhes mais tarde. A variável Nota não pode ser considerada normalmente distribuída, pois é discreta, assume poucos valores inteiros e resulta da soma de indicadores binários, apesar de poder apresentar alguma aproximação visual no centro da distribuição.
11. Calcule a correlação entre todas as variáveis dessa base. Quais são as 3 pares de variáveis mais correlacionadas?
Code
matriz <- cor (df_num, use = "complete.obs")
corrplot(
matriz,
method = "color",
type = "upper",
addCoef.col = "black",
tl.col = "black",
tl.srt = 45,
tl.cex = 0.8,
number.cex = 0.8
)
Code
cormat_long <- as.data.frame(as.table(matriz))
cormat_long %>%
filter(Freq != 1) %>%
rename(r = Freq) %>%
distinct(r, .keep_all = TRUE) %>%
arrange(desc(r)) %>%
gt()| Var1 | Var2 | r |
|---|---|---|
| Adocao | Casamento | 0.8989158 |
| Adocao | Uniao | 0.8906926 |
| Nota | Uniao | 0.8664986 |
| Nota | Militar | 0.8506664 |
| Nota | Adocao | 0.8397906 |
| Nota | LeisOrientacao | 0.8283188 |
| Casamento | Uniao | 0.8006576 |
| Nota | LeisGenero | 0.7914063 |
| Nota | Casamento | 0.7839770 |
| Nota | Atividade | 0.7600162 |
| Militar | Atividade | 0.7258840 |
| LeisOrientacao | Militar | 0.7118331 |
| LeisGenero | LeisOrientacao | 0.6891103 |
| LeisOrientacao | Atividade | 0.6619175 |
| Militar | Uniao | 0.6336319 |
| PIBpC | Adocao | 0.6308184 |
| LeisGenero | Militar | 0.6297424 |
| PIBpC | Casamento | 0.6281639 |
| LeisGenero | Atividade | 0.6146938 |
| LeisOrientacao | Uniao | 0.6060915 |
| Militar | Adocao | 0.5951190 |
| PIBpC | Uniao | 0.5933223 |
| LeisGenero | Uniao | 0.5813689 |
| Nota | PIBpC | 0.5773903 |
| LeisOrientacao | Adocao | 0.5398412 |
| Militar | Casamento | 0.5349619 |
| LeisGenero | Adocao | 0.5123629 |
| LeisOrientacao | Casamento | 0.4852718 |
| Uniao | Atividade | 0.4850017 |
| LeisGenero | Casamento | 0.4549315 |
| PIBpC | Militar | 0.4327509 |
| Adocao | Atividade | 0.4319874 |
| Casamento | Atividade | 0.3883203 |
| PIBpC | LeisGenero | 0.3876816 |
| PIBpC | Atividade | 0.3383461 |
| PIBpC | LeisOrientacao | 0.3330592 |
Adocao e Casamento - r=0,90, alta;
Adocao e Uniao - r=0,89, alta;
Nota e Uniao - r=0,87, alta (considerando que Uniao é parte de Nota, podemos interpretar que Uniao seja a parte que mais afeta a Nota).
12. Crie um scatterplot entre duas variáveis da resposta anterior. Qual a relação da imagem com a correlação entre as variáveis?
Code
df_num %>%
ggplot(aes(x=Nota, y=PIBpC))+
geom_point()+
geom_jitter(width = 0.2, height = 0)+
geom_smooth(method = "lm", se = FALSE, )+
scale_y_continuous(labels = scales::label_number(big.mark = ".", decimal.mark = ",")) +
theme_minimal()
Existe uma relação positiva entre as variáveis, visto que os valores maiores da Nota tendem a estar associados a valores mais altos do PIBpC (PIB per Capita), o que é coerente com uma correlação positiva, mas não muito forte.
13. Crie um gráfico linha de duas das variáveis. Acrescente uma legenda e rótulos nos eixos.
Code
df_num %>%
ggplot(aes(x = Nota, y = PIBpC)) +
geom_line() +
theme_minimal() +
scale_y_continuous(labels = scales::label_number(big.mark = ".", decimal.mark = ",")) +
labs(
title = "Gráfico de linha",
x = "Pontuação total/ Nota",
y = "PIB per Capita"
)