Atividade 3
Araê Cainã
09/12/2021
Exercício 1
db <- read.csv('ie_bpr_16pf.csv', sep = ';')
# Remove os indivíduos sem informações de idade
db <- db[!is.na(db$idade),]
# inveestiga qual as idade ideais para dividir os grupos por idade
idade <- data.frame(prop.table(table(db$idade)))
idade$cumulativo <- cumsum(idade$Freq)
idade <- sapply(idade, function(x) round(as.numeric(x), 2))
reactable(idade)Os participantes serão dividios em três grupos, por idade:
- Adolescentes com até 22 anos
- Jovens adultos entre 23 e 29 anos
- Adultos com mais de 30 anos
db <- db %>%
mutate(
idade_grupos = case_when(
idade <= 22 ~ 1,
idade >= 23 & idade <= 29 ~ 2,
idade >= 30 ~ 3
)
)
reactable(db)ANOVA Fatorial
Agora, faremos a ANOVA, considerando idade e sexo como VI e os cinco grandes fatores como VD. Antes iremos corrigir o nome das colunas.
Fator I
colnames(db)[4:8] <- c(
'fator_i',
'fator_ii',
'fator_iii',
'fator_iv',
'fator_v'
)
# Transforma em fator
db[,c('sexo', 'idade_grupos')] <- sapply(
db[,c('sexo', 'idade_grupos')],
factor
)
# Roda a ANOVA Fatorial (* a invés de +)
model_anova <- aov(fator_i ~ idade_grupos * sexo, data = db)
summary(model_anova)## Df Sum Sq Mean Sq F value Pr(>F)
## idade_grupos 2 41.3 20.650 7.270 0.000984 ***
## sexo 1 0.8 0.761 0.268 0.605604
## idade_grupos:sexo 2 6.9 3.448 1.214 0.300064
## Residuals 143 406.2 2.841
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Os resultados sugerem que existe diferença significativa entre os grupos divididos por idade, mas não entre os sexos. Uma análise post hoc de Tuckey foi realizada para compreender se a diferença se dá entre todos os grupos ou se existem grupos cujas diferenças são maiores.
TukeyHSD(model_anova)## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = fator_i ~ idade_grupos * sexo, data = db)
##
## $idade_grupos
## diff lwr upr p adj
## 2-1 0.2571429 -0.569199 1.08348472 0.7419364
## 3-1 -0.9290094 -1.765039 -0.09297976 0.0253886
## 3-2 -1.1861523 -1.951096 -0.42120864 0.0009822
##
## $sexo
## diff lwr upr p adj
## 2-1 0.1391583 -0.4205941 0.6989108 0.6238833
##
## $`idade_grupos:sexo`
## diff lwr upr p adj
## 2:1-1:1 0.110000000 -1.3415481 1.5615481 0.9999297
## 3:1-1:1 -1.249612403 -2.6164034 0.1171786 0.0941831
## 1:2-1:1 -0.265151515 -1.8125070 1.2822039 0.9962849
## 2:2-1:1 0.112820513 -1.3800120 1.6056531 0.9999307
## 3:2-1:1 -0.323333333 -2.2435510 1.5968843 0.9965801
## 3:1-2:1 -1.359612403 -2.5177876 -0.2014372 0.0113934
## 1:2-2:1 -0.375151515 -1.7417388 0.9914358 0.9683200
## 2:2-2:1 0.002820513 -1.3017105 1.3073515 1.0000000
## 3:2-2:1 -0.433333333 -2.2111094 1.3444427 0.9811893
## 1:2-3:1 0.984460888 -0.2917393 2.2606611 0.2313652
## 2:2-3:1 1.362432916 0.1529177 2.5719481 0.0174845
## 3:2-3:1 0.926279070 -0.7829938 2.6355519 0.6225424
## 2:2-1:2 0.377972028 -1.0323890 1.7883330 0.9714506
## 3:2-1:2 -0.058181818 -1.9150084 1.7986447 0.9999991
## 3:2-2:2 -0.436153846 -2.2477954 1.3754877 0.9821997Não foi possível encontrar diferença significativa entre as médias de adolescentes e jovens adultos (p > 0.05). Existe diferença significativa entre adolescentes e adultos e jovens adultos e adultos.
Fator II
# Roda a ANOVA Fatorial (* a invés de +)
model_anova <- aov(fator_ii ~ idade_grupos * sexo, data = db)
summary(model_anova)## Df Sum Sq Mean Sq F value Pr(>F)
## idade_grupos 2 11.6 5.819 1.327 0.268
## sexo 1 2.0 1.966 0.448 0.504
## idade_grupos:sexo 2 1.4 0.690 0.157 0.855
## Residuals 143 627.0 4.385Os resultados sugerem que existe diferença significativa entre os grupos divididos.
Fator III
# Roda a ANOVA Fatorial (* a invés de +)
model_anova <- aov(fator_iii ~ idade_grupos * sexo, data = db)
summary(model_anova)## Df Sum Sq Mean Sq F value Pr(>F)
## idade_grupos 2 8.0 4.00 1.748 0.178
## sexo 1 41.6 41.55 18.162 3.66e-05 ***
## idade_grupos:sexo 2 0.1 0.05 0.021 0.979
## Residuals 143 327.2 2.29
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Os resultados sugerem que existe diferença significativa entre os sexos, mas não por idade.
Fator IV
# Roda a ANOVA Fatorial (* a invés de +)
model_anova <- aov(fator_iv ~ idade_grupos * sexo, data = db)
summary(model_anova)## Df Sum Sq Mean Sq F value Pr(>F)
## idade_grupos 2 4.8 2.386 0.898 0.4099
## sexo 1 18.1 18.057 6.793 0.0101 *
## idade_grupos:sexo 2 4.5 2.250 0.847 0.4310
## Residuals 143 380.1 2.658
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Os resultados sugerem que existe diferença significativa entre sexos.
Fator V
# Roda a ANOVA Fatorial (* a invés de +)
model_anova <- aov(fator_v ~ idade_grupos * sexo, data = db)
summary(model_anova)## Df Sum Sq Mean Sq F value Pr(>F)
## idade_grupos 2 10.61 5.304 2.405 0.0939 .
## sexo 1 0.73 0.731 0.332 0.5656
## idade_grupos:sexo 2 0.75 0.376 0.171 0.8434
## Residuals 143 315.34 2.205
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Os resultados sugerem não existe diferença significativa entre os grupos.
Exercício 2
Modelo de Regressão Múltipla
model_ml <- lm(
av_des ~
# BPR-5
epn_ra + # Raciocínio Abstrato
epn_rv + # Raciocínio Verbal
epn_rm + # Raciocínio Mecânico
epn_re + # Raciocínio Espacial
epn_rn + # Raciocínio Numérico
# MSCEIT
experi + # Experencial (IEE)
etrateg # Estratégica (IES)
, data = db
)
summary(model_ml)##
## Call:
## lm(formula = av_des ~ epn_ra + epn_rv + epn_rm + epn_re + epn_rn +
## experi + etrateg, data = db)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.25568 -0.47386 0.06521 0.56694 1.38537
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.015e+00 7.436e-01 2.709 0.00784 **
## epn_ra 4.436e-03 6.814e-03 0.651 0.51639
## epn_rv 3.414e-05 6.816e-03 0.005 0.99601
## epn_rm -2.141e-04 6.584e-03 -0.033 0.97412
## epn_re 7.264e-03 7.112e-03 1.021 0.30933
## epn_rn 4.711e-03 7.043e-03 0.669 0.50500
## experi -2.537e-03 1.486e-02 -0.171 0.86477
## etrateg 2.852e-02 1.506e-02 1.894 0.06085 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.73 on 108 degrees of freedom
## (33 observations deleted due to missingness)
## Multiple R-squared: 0.1317, Adjusted R-squared: 0.07547
## F-statistic: 2.341 on 7 and 108 DF, p-value: 0.02899Predição do resultado com o modelo
db$av_predito <- predict(model_ml, db[,c(9:13, 21:22)])Correlação entre o real e o predito
cor(
db$av_des[!is.na(db$av_predito) & !is.na(db$av_des)],
db$av_predito[!is.na(db$av_predito) & !is.na(db$av_des)]
)## [1] 0.3629675Correlação moderada entre o valor real e o predito.
Gráfico
ggplot(
db,
aes(
x = av_des,
y = av_predito
)
) +
geom_point()+
geom_smooth(
method = 'lm'
)