Na aula do dia 25/08/2023, vimos como carregar um pacote, ler um banco de dados e excluir colunas.
OBS: um asterisco antes e depois torna o texto em itálico. Dois asteriscos antes e depois torna o terno em negrito.
# Lendo o pacote
library(titanic)Warning: package 'titanic' was built under R version 4.2.3# Atribuindo titanic_train para o objeto dados
dados <- titanic_train
# Excluindo colunas
dados$PassengerId <- NULL
dados$Name <- NULL
dados$Ticket <- NULL
dados$Cabin <- NULLPara começar, vamos ler um banco de dados externo:
library(readxl)Warning: package 'readxl' was built under R version 4.2.3dados_titanic <- read_excel("C:/Users/09226286701/Downloads/dados_titanic.xlsx")vamos excluir o nome dos passageiros:
dados_titanic$Nome <- NULLvamos agora corrigir algumas variáveis:
# vendo a estrutura dos dados
str(dados_titanic)tibble [891 × 8] (S3: tbl_df/tbl/data.frame)
$ Sobreviveu : num [1:891] 0 1 1 1 0 0 0 0 1 1 ...
$ Classe : num [1:891] 3 1 3 1 3 3 1 3 3 2 ...
$ Sexo : chr [1:891] "male" "female" "female" "female" ...
$ Idade : num [1:891] 22 38 26 35 35 NA 54 2 27 14 ...
$ N_irmaos_conjuges: num [1:891] 1 1 0 1 0 0 0 3 0 1 ...
$ N_pais_filhos : num [1:891] 0 0 0 0 0 0 0 1 2 0 ...
$ Tarifa : num [1:891] 7.25 71.28 7.92 53.1 8.05 ...
$ Porto : chr [1:891] "S" "C" "S" "S" ...# transformando para factor
dados_titanic$Sobreviveu <- as.factor(dados_titanic$Sobreviveu)
# transformando para factor
dados_titanic$Classe <- as.factor(dados_titanic$Classe)
# transformando para factor
dados_titanic$Sexo <- as.factor(dados_titanic$Sexo)
# transformando para factor
dados_titanic$Porto <- as.factor(dados_titanic$Porto)
# verificando se mudou
str(dados_titanic)tibble [891 × 8] (S3: tbl_df/tbl/data.frame)
$ Sobreviveu : Factor w/ 2 levels "0","1": 1 2 2 2 1 1 1 1 2 2 ...
$ Classe : Factor w/ 3 levels "1","2","3": 3 1 3 1 3 3 1 3 3 2 ...
$ Sexo : Factor w/ 2 levels "female","male": 2 1 1 1 2 2 2 2 1 1 ...
$ Idade : num [1:891] 22 38 26 35 35 NA 54 2 27 14 ...
$ N_irmaos_conjuges: num [1:891] 1 1 0 1 0 0 0 3 0 1 ...
$ N_pais_filhos : num [1:891] 0 0 0 0 0 0 0 1 2 0 ...
$ Tarifa : num [1:891] 7.25 71.28 7.92 53.1 8.05 ...
$ Porto : Factor w/ 3 levels "C","Q","S": 3 1 3 3 3 2 3 3 3 1 ...vamos mudar agora os nomes das categorias das variáveis qualitativas:
levels(dados_titanic$Sobreviveu)[1] "0" "1"levels(dados_titanic$Sobreviveu) <- c("Não", "Sim")
levels(dados_titanic$Classe)[1] "1" "2" "3"levels(dados_titanic$Classe) <- c("Primeira", "Segunda", "Terceira")
levels(dados_titanic$Sexo)[1] "female" "male" levels(dados_titanic$Sexo) <- c("Feminino", "Masculino")Vamos mudar agora o nome de uma variável
colnames(dados_titanic)[1] "Sobreviveu" "Classe" "Sexo"
[4] "Idade" "N_irmaos_conjuges" "N_pais_filhos"
[7] "Tarifa" "Porto" colnames(dados_titanic)[8] <- "Porto_de_Embarque"Vamos agora criar a variável faixa etária:
dados_titanic$Faixa_Etaria <- cut(dados_titanic$Idade,
c(0,18,65,200))
dados_titanic$Faixa_Etaria
levels(dados_titanic$Faixa_Etaria) <- c("Até 18 anos",
"Maior que 18 anos e até 65 anos",
"Maior que 65 anos")Vamos trabalhar com a variável classe econômica. Para começar, vamos construir uma tabela de distribuição de frequências.
Podemos observar que a maioria dos passageiros era da terceira classe (55,11%), com a segunda classe contendo a menor proporção de passageiros (20,65%) figura 1
library(summarytools)Warning: package 'summarytools' was built under R version 4.2.3freq(dados_titanic$Classe)Frequencies
dados_titanic$Classe
Type: Factor
Freq % Valid % Valid Cum. % Total % Total Cum.
-------------- ------ --------- -------------- --------- --------------
Primeira 216 24.24 24.24 24.24 24.24
Segunda 184 20.65 44.89 20.65 44.89
Terceira 491 55.11 100.00 55.11 100.00
<NA> 0 0.00 100.00
Total 891 100.00 100.00 100.00 100.00freq(dados_titanic$Porto_de_Embarque)Frequencies
dados_titanic$Porto_de_Embarque
Type: Factor
Freq % Valid % Valid Cum. % Total % Total Cum.
----------- ------ --------- -------------- --------- --------------
C 168 18.90 18.90 18.86 18.86
Q 77 8.66 27.56 8.64 27.50
S 644 72.44 100.00 72.28 99.78
<NA> 2 0.22 100.00
Total 891 100.00 100.00 100.00 100.00Vamos agora fazer um gráfico de barras para a variável classe econômica:
library(ggplot2)Warning: package 'ggplot2' was built under R version 4.2.3ggplot(dados_titanic) +
aes(x = Classe) +
geom_bar(fill = "#4682B4") +
labs(x = "Classe Econômica",
y = "Frequência", title = "Figura 1. Classe Econômica dos Passageiros do Titanic", caption = "Fonte: Autores") +
theme_minimal() +
theme(plot.title = element_text(size = 14L, face = "bold", hjust = 0.5))
c(“Terceira”, “Segunda”, “Primeira”))
A idade média dos passageiros foi de 29,7 anos (dp = 14,53 anos), com mediana igual a 28 anos. A variável pode ser classificada como assimétrica à direita (positiva) e heterogênea (cv > 0,30).
library(summarytools)
descr(dados_titanic$Idade)Descriptive Statistics
dados_titanic$Idade
N: 891
Idade
----------------- --------
Mean 29.70
Std.Dev 14.53
Min 0.42
Q1 20.00
Median 28.00
Q3 38.00
Max 80.00
MAD 13.34
IQR 17.88
CV 0.49
Skewness 0.39
SE.Skewness 0.09
Kurtosis 0.16
N.Valid 714.00
Pct.Valid 80.13Vamos agora observar a distribuição da variável idade pelos 3 gráficos aprendidos.
library(dplyr)Warning: package 'dplyr' was built under R version 4.2.3
Attaching package: 'dplyr'The following objects are masked from 'package:stats':
filter, lagThe following objects are masked from 'package:base':
intersect, setdiff, setequal, unionlibrary(ggplot2)
dados_titanic %>%
filter(!is.na(Idade)) %>%
ggplot() +
aes(x = Idade) +
geom_histogram(bins = 30L, fill = "#112446") +
labs(x = "Idade (anos)",
y = "Frequência absoluta", title = "Figura 2 - Distribuição da variável Idade") +
theme_minimal()
library(dplyr)
library(ggplot2)
dados_titanic %>%
filter(!is.na(Idade)) %>%
ggplot() +
aes(x = Idade) +
geom_density(fill = "#112446") +
labs(x = "Idade (anos)",
y = "Frequência absoluta", title = "Figura 3 - Distribuição da variável Idade") +
theme_gray() 
library(dplyr)
library(ggplot2)
dados_titanic %>%
filter(!is.na(Idade)) %>%
ggplot() +
aes(y = Idade) +
geom_boxplot(fill = "#112446") +
labs(x = "",
y = "Idade (anos)", title = "Figura 4 - Distribuição da variável Idade") +
theme_gray() 
Será que existe relação entre a classe econômica e a sobrevivência ao desastre do Titanic?
A tabela abaixo mostra que dos passageiros da primeira classe 37% deles não sobreviveram, enquanto que este percentual é maior na segunda (52,7%) e terceira (75,8%) classes.
library(summarytools)
ctable(dados_titanic$Classe, dados_titanic$Sobreviveu)Cross-Tabulation, Row Proportions
Classe * Sobreviveu
Data Frame: dados_titanic
---------- ------------ ------------- ------------- --------------
Sobreviveu Não Sim Total
Classe
Primeira 80 (37.0%) 136 (63.0%) 216 (100.0%)
Segunda 97 (52.7%) 87 (47.3%) 184 (100.0%)
Terceira 372 (75.8%) 119 (24.2%) 491 (100.0%)
Total 549 (61.6%) 342 (38.4%) 891 (100.0%)
---------- ------------ ------------- ------------- --------------library(ggplot2)
ggplot(dados_titanic) +
aes(x = Classe, fill = Sobreviveu) +
geom_bar(position = "dodge") +
scale_fill_brewer(palette = "Set1",
direction = 1) +
labs(x = "Classe econômica", y = "Frequência absoluta", title = "Figura 5 - Relação entre classe econômica e desfecho do passageiro") +
theme_minimal()
library(ggplot2)
ggplot(dados_titanic) +
aes(x = Classe, fill = Sobreviveu) +
geom_bar(position = "fill") +
scale_fill_brewer(palette = "Set1",
direction = 1) +
labs(x = "Classe econômica", y = "Frequência relativa", title = "Figura 6 - Relação entre classe econômica e desfecho do passageiro") +
theme_gray()
Existe correlação entre o número de filhos/pais a bordo e a idade do passageiro?
Ao analisar o coeficiente de correlação de Spearman, observamos uma correlação fraca e negativa (rho = -0,25).
library(ggplot2)
ggplot(dados_titanic) +
aes(x = Idade, y = N_pais_filhos) +
geom_point(shape = "circle", size = 1.5,
colour = "#228B22") +
geom_smooth(span = 1L) +
labs(x = "Idade (anos)", y = "Número de pais/filhos a bordo",
title = "Figura 7 - Correlação entre o número de pais/filhos e idade dos passageiros") +
theme_minimal()`geom_smooth()` using method = 'loess' and formula = 'y ~ x'Warning: Removed 177 rows containing non-finite values (`stat_smooth()`).Warning: Removed 177 rows containing missing values (`geom_point()`).
cor(dados_titanic$Idade, dados_titanic$N_pais_filhos,
use = "complete.obs", method = "spearman")[1] -0.2542121Existe relação entre a idade do passageiro e sua sobrevivência?
A partir das estatísticas, podemos observar que ambos os grupos apresentaram medianas iguais a 28 anos (IQR = 18 anos para o grupo Não e 17 anos para o grupo Sim). Quanto a assimetria, ambas as distribuições foram assimétricas positivas. A idade possui distribuição heterogênea em ambos os desfechos (CV > 0,30).
library(summarytools)
with(dados_titanic, stby(Idade, Sobreviveu, descr))Descriptive Statistics
Idade by Sobreviveu
Data Frame: dados_titanic
N: 549
Não Sim
----------------- -------- --------
Mean 30.63 28.34
Std.Dev 14.17 14.95
Min 1.00 0.42
Q1 21.00 19.00
Median 28.00 28.00
Q3 39.00 36.00
Max 74.00 80.00
MAD 11.86 13.34
IQR 18.00 17.00
CV 0.46 0.53
Skewness 0.58 0.18
SE.Skewness 0.12 0.14
Kurtosis 0.25 -0.10
N.Valid 424.00 290.00
Pct.Valid 77.23 84.80library(dplyr)
library(ggplot2)
dados_titanic %>%
filter(!is.na(Idade)) %>%
ggplot() +
aes(x = "", y = Idade, fill = Sobreviveu) +
geom_boxplot() +
scale_fill_hue(direction = 1) +
labs(x = " ", y = "Idade (anos)", title = "Figura 8 - Distribuição da idade segundo o desfecho dos passageiros") +
theme_minimal()
A Tabela 1 abaixo apresenta as características dos passageiros a bordo do Titanic. Podemos observar que 62% dos passageiros não sobreviveram ao acidente. Quanto à classe econômica, a maioria pertencia a terceira classe, representando 55% dos passageiros. 65% eram do sexo masculino e a mediana foi de 28 anos (IQP = 20 - 38 anos). Quanto ao número de pais ou filhos a bordo, 76% dos passageiros não tinham este tipo de acompanhante.
library(gtsummary)Warning: package 'gtsummary' was built under R version 4.2.3dados2 <- dados_titanic[, c("Sobreviveu",
"Classe",
"Sexo",
"Idade",
"N_pais_filhos",
"Tarifa")]
tbl_summary(dados2,
label = list(Sobreviveu ~ "Sobrevivente",
Classe ~ "Classe econômica",
N_pais_filhos ~ "Número de pais/filhos"),
missing_text = "Sem informação") %>% modify_header(label ~ "**Variável**") %>%
modify_caption("Tabela 1. Características dos passageiros do Titanic.") %>% bold_labels() %>%
italicize_levels()| Variável | N = 8911 |
|---|---|
| Sobrevivente | |
| Não | 549 (62%) |
| Sim | 342 (38%) |
| Classe econômica | |
| Primeira | 216 (24%) |
| Segunda | 184 (21%) |
| Terceira | 491 (55%) |
| Sexo | |
| Feminino | 314 (35%) |
| Masculino | 577 (65%) |
| Idade | 28 (20, 38) |
| Sem informação | 177 |
| Número de pais/filhos | |
| 0 | 678 (76%) |
| 1 | 118 (13%) |
| 2 | 80 (9.0%) |
| 3 | 5 (0.6%) |
| 4 | 4 (0.4%) |
| 5 | 5 (0.6%) |
| 6 | 1 (0.1%) |
| Tarifa | 14 (8, 31) |
| 1 n (%); Median (IQR) | |
rl <- lm(Tarifa ~ Sexo + Classe + Idade + N_pais_filhos, data = dados2)
summary(rl)
Call:
lm(formula = Tarifa ~ Sexo + Classe + Idade + N_pais_filhos,
data = dados2)
Residuals:
Min 1Q Median 3Q Max
-89.63 -9.45 -0.46 4.97 430.56
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 99.1396 5.6557 17.529 < 2e-16 ***
SexoMasculino -5.5850 3.3220 -1.681 0.09316 .
ClasseSegunda -69.0954 4.3887 -15.744 < 2e-16 ***
ClasseTerceira -78.7481 4.0287 -19.547 < 2e-16 ***
Idade -0.3369 0.1155 -2.916 0.00366 **
N_pais_filhos 11.5859 1.8631 6.219 8.57e-10 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 40.49 on 708 degrees of freedom
(177 observations deleted due to missingness)
Multiple R-squared: 0.4185, Adjusted R-squared: 0.4144
F-statistic: 101.9 on 5 and 708 DF, p-value: < 2.2e-16Ao observar os resultados do modelo, verificamos que apenas a variável sexo não foi significativa (valor-p > 0,05). Passageiros da segunda classe pagam, em média, 69 “moedas” a menos que os passageiros da primeira classe, enquanto os da terceira classe pagam, em média, 79 “moedas” a menos comparados a esta mesma classe. Em relação à idade, observamos que a cada 1 ano a mais, reduz-se, em média, a tarifa em 0,33 “moedas”. Quanto ao número de pais/filhos, o aumento de 1 unidade nesta variável aumenta a tarifa em 11,6 “moedas”. Em relação ao coeficiente de determinação (R2), este foi baixo, explicando apenas 44% da variabilidade da variável resposta.
rl2 <- lm(Tarifa ~ Classe + Idade + N_pais_filhos, data = dados2)
summary(rl2)
Call:
lm(formula = Tarifa ~ Classe + Idade + N_pais_filhos, data = dados2)
Residuals:
Min 1Q Median 3Q Max
-88.19 -9.26 -0.96 4.71 428.23
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 96.6890 5.4717 17.671 < 2e-16 ***
ClasseSegunda -69.4477 4.3893 -15.822 < 2e-16 ***
ClasseTerceira -80.0308 3.9609 -20.205 < 2e-16 ***
Idade -0.3598 0.1149 -3.133 0.0018 **
N_pais_filhos 12.3098 1.8150 6.782 2.5e-11 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 40.55 on 709 degrees of freedom
(177 observations deleted due to missingness)
Multiple R-squared: 0.4162, Adjusted R-squared: 0.4129
F-statistic: 126.4 on 4 and 709 DF, p-value: < 2.2e-16Ao observar os resultados do modelo 2, sem a variável sexo, passageiros da segunda classe pagam, em média, 69 “moedas” a menos que os passageiros da primeira classe, enquanto os da terceira classe pagam, em média, 80 “moedas” a menos comparados a esta mesma classe. Em relação à idade, observamos que a cada 1 ano a mais, reduz-se, em média, a tarifa em 0,36 “moedas”. Quanto ao número de pais/filhos, o aumento de 1 unidade nesta variável aumenta a tarifa em 12,3 “moedas”. Em relação ao coeficiente de determinação (R2), este foi baixo, explicando apenas 41% da variabilidade da variável resposta.
Vamos verificar se os pressupostos foram atendidos.
plot(rl2)
Ao analisar os gráficos do modelo, observamos que os presupostos de normalidade e homocedasticidade foram violados. Desta forma, o modelo de regressão linear não é o mais indicado para modelar a variabilidade da tarifa com base na classe, idade e número de pais/filhos a bordo.
-Variavel resposta: Sobreviveu
rlog <- glm(Sobreviveu ~ ., data = dados2,
family = binomial(link = "logit"))
summary(rlog)
Call:
glm(formula = Sobreviveu ~ ., family = binomial(link = "logit"),
data = dados2)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.6966 -0.6750 -0.4061 0.6323 2.4481
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.809152 0.473171 8.050 8.26e-16 ***
ClasseSegunda -1.244302 0.314836 -3.952 7.74e-05 ***
ClasseTerceira -2.480356 0.331877 -7.474 7.80e-14 ***
SexoMasculino -2.583233 0.214780 -12.027 < 2e-16 ***
Idade -0.037821 0.007834 -4.828 1.38e-06 ***
N_pais_filhos -0.164902 0.119644 -1.378 0.168
Tarifa 0.001356 0.002404 0.564 0.573
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 964.52 on 713 degrees of freedom
Residual deviance: 645.25 on 707 degrees of freedom
(177 observations deleted due to missingness)
AIC: 659.25
Number of Fisher Scoring iterations: 5Visto que número de pais e filhos e tarifa não foram significativas, vamos fazer um segundo modelo sem essas variáveis.
rlog2 <- glm(Sobreviveu ~ .-N_pais_filhos -Tarifa, data = dados2,
family = binomial(link = "logit"))
summary(rlog2)
Call:
glm(formula = Sobreviveu ~ . - N_pais_filhos - Tarifa, family = binomial(link = "logit"),
data = dados2)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.7303 -0.6780 -0.3953 0.6485 2.4657
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.777013 0.401123 9.416 < 2e-16 ***
ClasseSegunda -1.309799 0.278066 -4.710 2.47e-06 ***
ClasseTerceira -2.580625 0.281442 -9.169 < 2e-16 ***
SexoMasculino -2.522781 0.207391 -12.164 < 2e-16 ***
Idade -0.036985 0.007656 -4.831 1.36e-06 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 964.52 on 713 degrees of freedom
Residual deviance: 647.28 on 709 degrees of freedom
(177 observations deleted due to missingness)
AIC: 657.28
Number of Fisher Scoring iterations: 5library(gtsummary)
tbl_regression(rlog2, exponentiate = T)| Characteristic | OR1 | 95% CI1 | p-value |
|---|---|---|---|
| Classe | |||
| Primeira | — | — | |
| Segunda | 0.27 | 0.16, 0.46 | <0.001 |
| Terceira | 0.08 | 0.04, 0.13 | <0.001 |
| Sexo | |||
| Feminino | — | — | |
| Masculino | 0.08 | 0.05, 0.12 | <0.001 |
| Idade | 0.96 | 0.95, 0.98 | <0.001 |
| 1 OR = Odds Ratio, CI = Confidence Interval | |||
A partir do modelo final, observamos que passageiros da segunda classe apresentam 73% menos chances de sobreviver do que os da primeira classe. Já os da terceira classe apresentam 92% menos chances de sobreviver. Em relação ao sexo, os homens também apresentaram 92% menos chances de sobreviver quando comparados às mulheres. O aumento de um ano na idade reduz as chances de sobrevivência em 4%.
#install.packages("effects")library(effects)Warning: package 'effects' was built under R version 4.2.3Carregando pacotes exigidos: carDataWarning: package 'carData' was built under R version 4.2.3lattice theme set by effectsTheme()
See ?effectsTheme for details.plot(allEffects(rlog2))
rlog2 <- glm(Sobreviveu ~ .-N_pais_filhos -Tarifa, data = dados2,
family = binomial(link = "logit"))
library(gtsummary)
tbl_regression(rl2)| Characteristic | Beta | 95% CI1 | p-value |
|---|---|---|---|
| Classe | |||
| Primeira | — | — | |
| Segunda | -69 | -78, -61 | <0.001 |
| Terceira | -80 | -88, -72 | <0.001 |
| Idade | -0.36 | -0.59, -0.13 | 0.002 |
| N_pais_filhos | 12 | 8.7, 16 | <0.001 |
| 1 CI = Confidence Interval | |||