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 termo 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$Ticket <- NULL
dados$Cabin <-NULL
dados$Name <-NULLVamos ler um banco de dados externo:
library(readxl)Warning: package 'readxl' was built under R version 4.2.3dados_titanic <- read_excel("C:/Users/13160187764/Downloads/dados_titanic.xlsx")Vamos excluir o nome dos passageiros:
dados_titanic$Nome<-NULLVamos corrigir algumas variáveis
# Vendo a estrura 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 fator
dados_titanic$Sobreviveu <- as.factor(dados_titanic$Sobreviveu)
dados_titanic$Classe <- as.factor(dados_titanic$Classe)
dados_titanic$Sexo <- as.factor(dados_titanic$Sexo)
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 e menor que 65 anos", "Maior que 65 anos")Vamos trabalhar com a variável classes econômica. Para começar, vamos construir uma tabela de distribuição de frequência. Podemos observar que a maioria dos passageiros era da terceira classe (55,11%), sendo 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:
# Mudando a ordem das categorias
dados_titanic$Classe <- factor(dados_titanic$Classe, levels = c("Terceira", "Segunda", "Primeira"))
library(ggplot2)Warning: package 'ggplot2' was built under R version 4.2.3ggplot(dados_titanic) +
aes(x = Classe) +
geom_bar(fill = "slateblue3") +
labs(x = "Classe Econômica",
y = "Frequência", title = "Figura 1: Classe Econômica dos passageiros do Titanic", subtitle = ":)") +
coord_flip() +
theme_minimal() +
theme(plot.title = element_text(face = "bold.italic", hjust = 0.5))
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 = "#0300FB") +
labs(x = "Idade (em anos)",
y = "Frequência absoluta", title = "Figura 2. Distribuição da variável idade") +
theme_gray()
library(dplyr)
library(ggplot2)
dados_titanic %>%
filter(!is.na(Idade)) %>%
ggplot() +
aes(x = Idade) +
geom_density(fill = "#0300FB") +
labs(x = "Idade (em anos)",
y = "Densidade", 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 = "#0300FB", width = 0.35) +
labs(x = "",
y = "Idade (em anos)", title = "Figura 4. Distribuição da variável idade") +
theme_gray() + xlim(c(-1,1))
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 nas 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
Terceira 372 (75.8%) 119 (24.2%) 491 (100.0%)
Segunda 97 (52.7%) 87 (47.3%) 184 (100.0%)
Primeira 80 (37.0%) 136 (63.0%) 216 (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_manual(values = c(não = "#FF0000",
sim = "#00FF14")) +
labs(x = "Classe econômica", y = "Frequência absoluta", title = "Figura 5. Relação entre classe econômica e desfecho do passageiro",
subtitle = ":)") +
theme_grey()
library(ggplot2)
ggplot(dados_titanic) +
aes(x = Classe, fill = Sobreviveu) +
geom_bar(position = "fill") +
scale_fill_manual(values = c(não = "#FF0000",
sim = "#00FF14")) +
labs(x = "Classe econômica", y = "Frequência relativa", title = "Figura 6. Relação entre classe econômica e desfecho do passageiro",
subtitle = ":)") +
theme_grey()
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 = "triangle", size = 1.5,
colour = "#112446") +
geom_smooth(span = 1L) +
labs(x = "Idade (em anos)", y = "Número de pais/filhos a bordo",
title = "Figura 7. Correlação entre o número de filhos/pais e a idade dos passageiros", subtitle = ":)") +
theme_gray()`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 grupo Não e 17 anos para grupo Sim). Quanto à 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(ggplot2)
ggplot(dados_titanic) +
aes(x = "", y = Idade, fill = Sobreviveu) +
geom_boxplot() +
scale_fill_manual(values = c(não = "#FF1100",
sim = "#15FD00")) +
labs(x = " ", y = "Idade (em anos)", title = "Figura 8. Distribuição da idade segundo o desfecho do passageiro",
subtitle = ":)") +
theme_grey()Warning: Removed 177 rows containing non-finite values (`stat_boxplot()`).
A Tabela 1 abaixo apresenta as características dos passageiros a bordo do Titanic. Podemos obervar que 62% dos passageiros não sobreviveram ao acidente. Quanto a classe econômica, a maioria pertencia a terceira classe, representando 55% dos passageiros. 65% eram do sexo masculino e a idade mediana foi de 28 anos(IQR = 20 - 38 anos).Quanto ao nùmero de pais ou filhos a bordo, 76% dos passageiros não tinham esse 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 | |
| Terceira | 491 (55%) |
| Segunda | 184 (21%) |
| Primeira | 216 (24%) |
| 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) | |
#Aula 5
Vamos agora avaliar se existe diferença estatísticamente siginificativa entre as idades dos passageiros que sobreviveram e morreram no acidente do Titanic.
1- Avaliando a normalidade - TEste de Shapiro-wilk H0: Os dados vêm de uma população normal. HA: Os dados não vêm de uma população normal.
shapiro.test(dados2$Idade[dados2$Sobreviveu == "não"])
Shapiro-Wilk normality test
data: dados2$Idade[dados2$Sobreviveu == "não"]
W = 0.96894, p-value = 7.816e-08Uma vez que o valor-p < 0,001 para a idade no grupo dos que não sobreviveram, temos que a variável do grupo não apresenta distribuição normal para este grupo, logo, teremos que utilizar o teste de Mann-whitney.
Dessa forma. as hipóteses em estudo são:
H0: Não há diferença de idade entre os que morreram e os que sobreviveram. HA: Não há diferença de idade entre os que morreram e os que sobreviveram.
wilcox.test(Idade ~ Sobreviveu, data = dados2, paired = F)
Wilcoxon rank sum test with continuity correction
data: Idade by Sobreviveu
W = 65278, p-value = 0.1605
alternative hypothesis: true location shift is not equal to 0Uma vez que o teste de Mann-whitney apresentou valor-p - 0,16, nossos dados sugerem que não há diferença de idade entre os que sobreviveram e os que morreram.
Verificando para o segundo grupo
shapiro.test(dados2$Idade[dados2$Sobreviveu == "sim"]) # também não tem distribuição normal, mas vamos supor que tem
Shapiro-Wilk normality test
data: dados2$Idade[dados2$Sobreviveu == "sim"]
W = 0.98273, p-value = 0.001426Sendo os dois grupos normais, precisamos avaliar a homocedasticidade.
library(car)Warning: package 'car' was built under R version 4.2.3Carregando pacotes exigidos: carDataWarning: package 'carData' was built under R version 4.2.3
Attaching package: 'car'The following object is masked from 'package:dplyr':
recodeleveneTest(Idade ~ Sobreviveu, data = dados2)Levene's Test for Homogeneity of Variance (center = median)
Df F value Pr(>F)
group 1 1.1954 0.2746
712 Como o valor-p do teste de Levene foi igual a 0,27, temos que os grupos são homocedásticos e, portanto, daremos o teste T (nesta simulação).
H0: Não há diferença entre as médias das idades dos que morreram e sobreviveram. HA: Há diferença entre as médias das idades dos que morreram e sobreviveram.
t.test(Idade ~ Sobreviveu, data = dados2, var.equal = T)
Two Sample t-test
data: Idade by Sobreviveu
t = 2.0667, df = 712, p-value = 0.03912
alternative hypothesis: true difference in means between group não and group sim is not equal to 0
95 percent confidence interval:
0.114181 4.450798
sample estimates:
mean in group não mean in group sim
30.62618 28.34369 t.test(Idade ~ Sobreviveu, data = dados2, var.equal = F)
Welch Two Sample t-test
data: Idade by Sobreviveu
t = 2.046, df = 598.84, p-value = 0.04119
alternative hypothesis: true difference in means between group não and group sim is not equal to 0
95 percent confidence interval:
0.09158472 4.47339446
sample estimates:
mean in group não mean in group sim
30.62618 28.34369 Aplicando o teste T, encontramos um valor-p igual a 0,04, indicando haver uma diferença estatisticamente significativa entre as médias, sendo o maior grupo dos que não sobreviveram aquele com maior média (igual a 30,6 anos).
Temos dois tipos de testes para avaliar grupos pareados: - Teste T pareado (paramétrico) - A diferença de valores precisa ser normal: avaliar com o teste de Shapiro-wilk - Teste de Wilcoxon (não pareado) - Usar caso a diferença não seja normal
library(BSDA)Warning: package 'BSDA' was built under R version 4.2.3Carregando pacotes exigidos: lattice
Attaching package: 'BSDA'The following objects are masked from 'package:carData':
Vocab, WoolThe following object is masked from 'package:datasets':
Orangedata(Blood)
Blood# A tibble: 15 × 2
machine expert
<int> <int>
1 68 72
2 82 84
3 94 89
4 106 100
5 92 97
6 80 88
7 76 84
8 74 70
9 110 103
10 93 84
11 86 86
12 65 63
13 74 69
14 84 87
15 100 93Blood$dif <- Blood$machine - Blood$expert
Blood# A tibble: 15 × 3
machine expert dif
<int> <int> <int>
1 68 72 -4
2 82 84 -2
3 94 89 5
4 106 100 6
5 92 97 -5
6 80 88 -8
7 76 84 -8
8 74 70 4
9 110 103 7
10 93 84 9
11 86 86 0
12 65 63 2
13 74 69 5
14 84 87 -3
15 100 93 7shapiro.test(Blood$dif)
Shapiro-Wilk normality test
data: Blood$dif
W = 0.92609, p-value = 0.2383Uma vez que o teste de Shapiro-wilk apresentou valor-p igual a 0,24, podemos inferir que os dados seguem distribuição normal, logo aplicaremos o teste T pareado.
H0: Não há diferença entre as médias das pressões mensuradas por máquina e homem. HA: Há diferençaentre as médias das pressões mensuradas por máquina e homem.
t.test(Blood$machine, Blood$expert, paired = T)
Paired t-test
data: Blood$machine and Blood$expert
t = 0.68162, df = 14, p-value = 0.5066
alternative hypothesis: true mean difference is not equal to 0
95 percent confidence interval:
-2.146615 4.146615
sample estimates:
mean difference
1 A partir do teste T pareado, podemos inferir que não há diferença estatisticamente significativa entre as médias das pressões mensuradas pela máquina e pelo homem (valor-p = 0,51
H0: Não há diferença entre as pressões mensuradas por máquina e homem. HA: Há diferença entre as pressões mensuradas por máquina e homem.
wilcox.test(Blood$machine, Blood$expert, paired = T)
Wilcoxon signed rank test with continuity correction
data: Blood$machine and Blood$expert
V = 64, p-value = 0.489
alternative hypothesis: true location shift is not equal to 0A partir do teste de wilcoxon, podemos inferir que não há diferenã estatisticamente significativa entre as pressões mensuradas pela máquina e pelo homem (valor-p = 0,49).
#Aula 6
Existe diferença de idade em relação à classe econômica?
Para analisar esta pergunta, temos 3 possibilidades: ANOVA, ANOVA com welsh e Teste de Kruskal-Wallis.
Para começar precisamos avaliar a normalidade dos 3 grupos:
shapiro.test(dados2$Idade[dados2$Classe=="Primeira"])
Shapiro-Wilk normality test
data: dados2$Idade[dados2$Classe == "Primeira"]
W = 0.99169, p-value = 0.3643shapiro.test(dados2$Idade[dados2$Classe=="Segunda"])
Shapiro-Wilk normality test
data: dados2$Idade[dados2$Classe == "Segunda"]
W = 0.97695, p-value = 0.005648shapiro.test(dados2$Idade[dados2$Classe=="Terceira"])
Shapiro-Wilk normality test
data: dados2$Idade[dados2$Classe == "Terceira"]
W = 0.97344, p-value = 4.186e-06Como o valor-p do teste de Shapiro-Wilk foi menor que 0,05 para a idade dos passageiros da Segunda classe, teremos que aplicar o teste de Kruskal-Wallis.
H0: Não há diferença das idades segundo a classe econômica H1: Há diferença entre as idades segundo a classe econômica
p<0,001
kruskal.test(Idade ~ Classe, data = dados2)
Kruskal-Wallis rank sum test
data: Idade by Classe
Kruskal-Wallis chi-squared = 95.995, df = 2, p-value < 2.2e-16Uma vez que o teste de Kruskal-Wallis apresentou valor-p < 0,001, sabemos que pelo menos um dos grupos difere, portanto precisamos realizar post-hoc de Dunn para verificar quais grupos diferem entre si.
library(DescTools)Warning: package 'DescTools' was built under R version 4.2.3
Attaching package: 'DescTools'The following object is masked from 'package:car':
RecodeDunnTest(Idade ~ Classe, data = dados2)
Dunn's test of multiple comparisons using rank sums : holm
mean.rank.diff pval
Segunda-Terceira 77.68906 4.8e-05 ***
Primeira-Terceira 182.19861 < 2e-16 ***
Primeira-Segunda 104.50956 3.2e-06 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Após aplicar o teste de Dunn, foi possível observar que os três grupos diferem, sendo a primeira classe o grupo com maiores valores de idade, seguido da segunda classe.
##CASO OS TRÊS GRUPOS TIVESSEM APRESENTADO NORMALIDADE…
Precisamos avaliar se os grupos apresentam homocedasticidade.(teste de Levene)
library(car)
LeveneTest(Idade ~ Classe, data = dados2)Levene's Test for Homogeneity of Variance (center = median)
Df F value Pr(>F)
group 2 5.6202 0.003787 **
711
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Como o teste de Levene indicou um valor-p menor que o nível de significância, o teste correto a ser aplicado será a ANOVA com Welch.
H0: Não há diferença entre as médias das idades segundo a Classe econômica (descartada) HA: Há diferença entre as médias das idades segundo a Classe econômica
oneway.test(Idade ~ Classe, data = dados2)
One-way analysis of means (not assuming equal variances)
data: Idade and Classe
F = 53.355, num df = 2.00, denom df = 359.44, p-value < 2.2e-16Visto que a ANOVA com welsh indicou que pelo menos um dos grupos difere, precisamos identificar quais diferem entre eles. Para isso, vamos usar o teste de Tukey.
OBS: Casp tivessemos homocedasticidade, faríamos a ANOVA.
anova <- aov(Idade ~ Classe, data = dados2)
summary(anova) Df Sum Sq Mean Sq F value Pr(>F)
Classe 2 20930 10465 57.44 <2e-16 ***
Residuals 711 129527 182
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
177 observations deleted due to missingnessTukeyHSD(anova) Tukey multiple comparisons of means
95% family-wise confidence level
Fit: aov(formula = Idade ~ Classe, data = dados2)
$Classe
diff lwr upr p adj
Segunda-Terceira 4.737010 1.797742 7.676279 0.0004884
Primeira-Terceira 13.092821 10.223445 15.962198 0.0000000
Primeira-Segunda 8.355811 5.007489 11.704133 0.0000000A partir do teste de Tukey, foi possível observar uma diferença significativa entre as médias de todas as comparações, indicando que a primeira classe apresenta média maior que a segunda, seguida da terceira classe.
##Testes de Associação
Existe associação entre a classe econômica e o desfecho do passageiro?
H0: Não existe associação entre a classe econômica e o desfecho do passageiro HA: Existe associação entre a classe econômica e o desfecho do passageiro
chisq.test(dados2$Classe, dados2$Sobreviveu)
Pearson's Chi-squared test
data: dados2$Classe and dados2$Sobreviveu
X-squared = 102.89, df = 2, p-value < 2.2e-16library(summarytools)
ctable(dados2$Classe, dados2$Sobreviveu)Cross-Tabulation, Row Proportions
Classe * Sobreviveu
Data Frame: dados2
---------- ------------ ------------- ------------- --------------
Sobreviveu não sim Total
Classe
Terceira 372 (75.8%) 119 (24.2%) 491 (100.0%)
Segunda 97 (52.7%) 87 (47.3%) 184 (100.0%)
Primeira 80 (37.0%) 136 (63.0%) 216 (100.0%)
Total 549 (61.6%) 342 (38.4%) 891 (100.0%)
---------- ------------ ------------- ------------- --------------Visto que o teste qui-quadrado apresentou um valor-p < 0,001, os dados sugerem que há uma associalçao estatisticamente significativa entre a classe econômica e o desfecho dos passageiros, indicando que passageiros da primeira classe sobreviveram mais, enquanto passageiros da terceira classe morreram mais.
Usaríamos o teste exato de Fisher:
fisher.test(dados2$Classe, dados2$Sobreviveu)
Fisher's Exact Test for Count Data
data: dados2$Classe and dados2$Sobreviveu
p-value < 2.2e-16
alternative hypothesis: two.sidedExiste correlação entre a idade dos passageiros com o número de pais ou filhos a bordo?
H0:Não há correlação entre a idade dos passageiros com o número de pais ou filhos a bordo HA:Há correlação entre a idade dos passageiros com o número de pais ou filhos a
Vamos começar analisando a normalidade:
shapiro.test(dados2$Idade)
Shapiro-Wilk normality test
data: dados2$Idade
W = 0.98146, p-value = 7.337e-08Visto que a variável idade não apresenta normalidade, o teste correto a ser realizado é o teste de correlação de Spearman.
cor.test(dados2$Idade, dados2$N_pais_filhos, method = "spearman")Warning in cor.test.default(dados2$Idade, dados2$N_pais_filhos, method =
"spearman"): Impossível calcular o valor exato de p com empates
Spearman's rank correlation rho
data: dados2$Idade and dados2$N_pais_filhos
S = 76087537, p-value = 5.409e-12
alternative hypothesis: true rho is not equal to 0
sample estimates:
rho
-0.2542121 Ao realizar o teste de correlação de Spearman, foi obtido um valor-p < 0,001, indicando haver uma correlação estatisticamente significativa entre as variáveis. O coeficiente de correlação rho = -0,25 indica que esta correlação é negativa, porém fraca. Dessa forma, quanto maior a idade do passageiro, menor o número de pais/filhos a bordo.
cor.test(dados2$Idade, dados2$N_pais_filhos, method = "pearson")
Pearson's product-moment correlation
data: dados2$Idade and dados2$N_pais_filhos
t = -5.1391, df = 712, p-value = 3.57e-07
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
-0.2588990 -0.1173757
sample estimates:
cor
-0.1891193 Vamos começar nossa análise construindo um modelo de regressão linear. Para isso, nossa variável resposta precisa ser quantitativa, de preferência contínua.
dados2$Classe <- factor(dados2$Classe, levels = c("Primeira", "Segunda", "Terceira"))
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-16rl2 <- 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-16plot(rl2)
Ao analisar os gráficos do modelo, observamos que os pressupostos de normalidade e homocedasticidade foram violados. Dessa 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.
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 estas 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 chance de sobreviver do que os da primeira classe, enquanto os da terceira classe apresentam 92% meno chances de sobreviver do que os da primeira classe. Em relação ao sexo, os homens também apresentaram 92% menos chances de sobreviver quando comparados às mulheres. O aumento de um ano da idade reduz as chances de sobrevivência em 4%.
library(effects)Warning: package 'effects' was built under R version 4.2.3Use the command
lattice::trellis.par.set(effectsTheme())
to customize lattice options for effects plots.
See ?effectsTheme for details.plot(allEffects(rlog2))