Atividade Pesquisa Experimental
Vitor Klein Schmidt
21 junho, 2021
1 Pacotes
library(outliers)
library(tidyverse)
library(psych)
library(FSA)
library(rstatix)
library(psych)
library(jtools)
library(interactions)
library(jtools)
library(interactions)2 Manipulação da base
colnames(data)[1] <- 'Duração'
colnames(data)[21] <- 'B_Esquerda'
colnames(data)[22] <- 'B_Direita'
colnames(data)[23] <- 'B_Controle'
data <- as.data.frame(sapply(data, as.numeric)) # Veio tudo como string, converti todas para numeric
data[is.na(data)] <- 0 # Converter os NA's para 0
data$B_Esquerda <- factor(data$B_Esquerda, levels = c(0, 1), labels = c("Não", "Sim")) # Converter para factor,com nível básico 'Não'
data$B_Direita <- factor(data$B_Direita, levels = c(0, 1), labels = c("Não", "Sim"))
data$B_Controle <- factor(data$B_Controle, levels = c(0, 1), labels = c("Não", "Sim"))
str(data) # Nos trinques## 'data.frame': 157 obs. of 23 variables:
## $ Duração : num 145 207 211 176 213 348 361 157 360 198 ...
## $ Finished : num 1 1 1 1 1 1 1 1 1 1 ...
## $ atitude_1 : num 6 4 7 4 6 6 7 5 4 6 ...
## $ atitude_2 : num 3 5 4 3 2 5 4 3 4 3 ...
## $ atitude_3 : num 5 7 4 4 3 4 7 4 4 5 ...
## $ atitude_4 : num 5 6 7 5 3 6 7 2 5 3 ...
## $ atitude_5 : num 5 4 5 4 4 5 4 1 5 3 ...
## $ atitude_6 : num 3 7 7 3 2 5 4 1 5 1 ...
## $ atitude_7 : num 4 7 7 3 3 6 4 1 5 1 ...
## $ atitude_8 : num 6 7 5 5 3 6 7 3 5 2 ...
## $ atitude_9 : num 1 5 5 2 2 4 7 1 5 1 ...
## $ atitude_10 : num 3 4 5 2 3 6 4 1 5 1 ...
## $ autenticidade_1: num 3 5 3 3 2 4 5 3 3 3 ...
## $ autenticidade_2: num 3 5 5 4 2 4 5 2 5 4 ...
## $ autenticidade_3: num 3 4 4 3 2 4 5 2 1 3 ...
## $ autenticidade_4: num 3 3 3 3 3 3 5 4 1 3 ...
## $ genero : num 2 1 1 1 1 1 1 1 2 1 ...
## $ idade : num 24 24 25 28 26 27 56 23 34 26 ...
## $ renda : num 3 5 3 5 4 2 3 4 4 2 ...
## $ escolaridade : num 5 5 6 7 7 6 4 5 7 6 ...
## $ B_Esquerda : Factor w/ 2 levels "Não","Sim": 1 1 2 1 1 2 1 1 2 1 ...
## $ B_Direita : Factor w/ 2 levels "Não","Sim": 2 1 1 1 2 1 1 2 1 2 ...
## $ B_Controle : Factor w/ 2 levels "Não","Sim": 1 2 1 2 1 1 2 1 1 1 ...3 Questão 1
Na sua opinião, algum caso deve ser eliminado da amostra? Indique qual(is) caso(s) e justifique sua resposta. Independente da sua respota, mantenha o número de casos intacto para as análises posteriores.
3.1 Verificar se todos terminaram o questionário
summary(data$Finished) # Nenhum valor !1, todos terminaram## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1 1 1 1 1 13.2 Análise de Outliers
3.2.1 Outliers para Duração
boxplot(data$Duração)
boxplot.stats(data$Duração, coef = 3)$out## [1] 2256 1336 7796 1643 852 1316 753 1330outliers::outlier(data$Duração) # Superior## [1] 7796outliers::outlier(data$Duração, opposite = T) # Inferior## [1] 99out <- boxplot.stats(data$Duração)$out
(out_ind <- which(data$Duração %in% c(out))) # Observações que são possíveis outliers para duração de resposta## [1] 29 30 45 55 69 77 79 113 118 119 137 142 147 152# Usando valores padronizados -+ 3 desvios padrões, 99% dos dados devem estar dentro desta distribuição
data$Duração_Out <- scale(data$Duração)
data %>% arrange(desc(data$Duração_Out)) %>% head() # Definitivamente o caso 77 é um outliers z = 11.33## Duração Finished atitude_1 atitude_2 atitude_3 atitude_4 atitude_5 atitude_6
## 1 7796 1 7 7 7 7 1 7
## 2 2256 1 6 6 6 2 7 7
## 3 1643 1 1 2 3 1 1 1
## 4 1336 1 6 4 5 7 6 7
## 5 1330 1 4 5 6 4 4 1
## 6 1316 1 4 1 3 6 3 4
## atitude_7 atitude_8 atitude_9 atitude_10 autenticidade_1 autenticidade_2
## 1 7 7 7 7 4 2
## 2 6 7 7 7 4 4
## 3 1 4 1 1 1 1
## 4 7 7 6 7 3 5
## 5 4 6 4 1 1 3
## 6 6 7 5 4 3 3
## autenticidade_3 autenticidade_4 genero idade renda escolaridade B_Esquerda
## 1 2 2 1 69 2 5 Sim
## 2 4 4 1 68 2 5 Não
## 3 1 1 1 26 5 5 Não
## 4 4 3 2 33 1 6 Sim
## 5 2 2 1 27 4 6 Não
## 6 4 1 2 24 3 5 Não
## B_Direita B_Controle Duração_Out
## 1 Não Não 11.330444
## 2 Sim Não 2.891273
## 3 Não Sim 1.957481
## 4 Não Não 1.489822
## 5 Não Sim 1.480683
## 6 Não Sim 1.459356data %>% arrange(desc(data$Duração_Out)) %>% tail()## Duração Finished atitude_1 atitude_2 atitude_3 atitude_4 atitude_5
## 152 129 1 5 3 4 4 4
## 153 128 1 3 4 3 2 2
## 154 127 1 3 1 2 3 1
## 155 113 1 4 3 4 5 5
## 156 104 1 3 2 3 1 2
## 157 99 1 4 2 2 4 4
## atitude_6 atitude_7 atitude_8 atitude_9 atitude_10 autenticidade_1
## 152 4 4 5 4 1 3
## 153 2 1 2 1 3 1
## 154 1 3 4 2 1 3
## 155 5 5 5 5 5 5
## 156 3 3 4 2 2 3
## 157 4 4 4 4 4 3
## autenticidade_2 autenticidade_3 autenticidade_4 genero idade renda
## 152 3 3 3 2 20 3
## 153 1 1 1 1 22 1
## 154 4 3 2 2 28 4
## 155 5 5 5 2 27 5
## 156 3 2 2 1 23 4
## 157 3 3 3 1 23 2
## escolaridade B_Esquerda B_Direita B_Controle Duração_Out
## 152 5 Não Não Sim -0.3488200
## 153 5 Não Não Sim -0.3503433
## 154 8 Sim Não Não -0.3518666
## 155 6 Não Sim Não -0.3731930
## 156 5 Não Não Sim -0.3869029
## 157 7 Não Não Sim -0.3945194which(data$Duração_Out > 3) # Caso 77## [1] 77DadosSem77 <- data[-77, ]
boxplot(DadosSem77$Duração) 
Ainda não tá bom, mas removemos o caso super extremo de alguém que demorou 2 horas para responder
3.2.2 Análise de outliers multivariados na escala de Atitude (Mahalanobis)
mahal <- mahalanobis(data[,c(3:12)],
colMeans(data[, c(3:12)], na.rm = T),
cov(data[, c(3:12)], use = "pairwise.complete.obs"))
Corte <- qchisq(1-0.001, ncol(data[, c(3:12)])) # Valor do corte = 29.5883
summary(mahal > Corte) # temos tbm 1 outliers multivariado nessa escala## Mode FALSE TRUE
## logical 156 1which(mahal > Corte) # Caso 77, quem iria adivinhar## [1] 773.2.3 Análise de outliers multivariados na escala de Autenticidade (Mahalanobis)
mahal2 <- mahalanobis(data[,c(13:16)],
colMeans(data[, c(13:16)], na.rm = T),
cov(data[, c(13:16)], use = "pairwise.complete.obs"))
Corte2 <- qchisq(1-0.001, ncol(data[, c(13:16)])) # Valor do corte = 18.46683
summary(mahal2 > Corte2) # temos tbm 1 outliers multivariado nessa escala## Mode FALSE TRUE
## logical 156 1which(mahal2 > Corte2) # Caso 9## [1] 93.2.4 Outras variáveis
boxplot(data$idade)
boxplot.stats(data$idade)$out # Algumas pessoas mais velhas ## [1] 56 56 65 68 66 52 59 65 66 60 62 65 63 69 58 59 60 64 55 57 61 66 63boxplot(data$renda)
boxplot(data$escolaridade) # nada preocupante
Resposta: Definitivamente o caso 77 deveria ser removido da amostra por ter demorado muito mais do que a média para responder e por tbm ter um padrão diferente no que tange ao constructo Autenticidade
4 Questão 2
Quantos respondentes temos em cada condição experimental?
contagem <- data.frame(
sum(data$B_Esquerda == "Sim"),
sum(data$B_Direita == "Sim"),
sum(data$B_Controle == "Sim"))
colnames(contagem) <- c('Esquerda', 'Direita', 'Controle')
contagem## Esquerda Direita Controle
## 1 54 51 52Resposta: 54 na condição Esquerda, 51 na condição direita, 52 na condição controle
5 Questão 3
Qual o perfil do respondente? Para as variáveis “Gênero” e “Idade”, apresente gráficos (barras e histograma, respectivamente).
data_perfil <- data[, c(17:23)]
describe.by(data_perfil)## vars n mean sd median trimmed mad min max range skew
## genero 1 157 1.31 0.46 1 1.26 0.00 1 2 1 0.84
## idade 2 157 32.48 13.32 27 30.07 4.45 20 69 49 1.50
## renda 3 157 3.41 1.07 3 3.46 1.48 1 5 4 -0.32
## escolaridade 4 157 5.97 0.99 6 5.93 1.48 4 9 5 0.30
## B_Esquerda* 5 157 1.34 0.48 1 1.31 0.00 1 2 1 0.65
## B_Direita* 6 157 1.32 0.47 1 1.28 0.00 1 2 1 0.74
## B_Controle* 7 157 1.33 0.47 1 1.29 0.00 1 2 1 0.71
## kurtosis se
## genero -1.31 0.04
## idade 0.91 1.06
## renda -0.48 0.09
## escolaridade -0.52 0.08
## B_Esquerda* -1.59 0.04
## B_Direita* -1.46 0.04
## B_Controle* -1.50 0.04describeBy(data_perfil, group = data$B_Esquerda)##
## Descriptive statistics by group
## group: Não
## vars n mean sd median trimmed mad min max range skew
## genero 1 103 1.30 0.46 1 1.25 0.00 1 2 1 0.86
## idade 2 103 32.04 12.94 27 29.66 5.93 20 68 48 1.49
## renda 3 103 3.36 1.06 3 3.37 1.48 1 5 4 -0.15
## escolaridade 4 103 5.95 1.01 6 5.93 1.48 4 9 5 0.26
## B_Esquerda* 5 103 1.00 0.00 1 1.00 0.00 1 1 0 NaN
## B_Direita* 6 103 1.50 0.50 1 1.49 0.00 1 2 1 0.02
## B_Controle* 7 103 1.50 0.50 2 1.51 0.00 1 2 1 -0.02
## kurtosis se
## genero -1.28 0.05
## idade 0.90 1.27
## renda -0.63 0.10
## escolaridade -0.56 0.10
## B_Esquerda* NaN 0.00
## B_Direita* -2.02 0.05
## B_Controle* -2.02 0.05
## ------------------------------------------------------------
## group: Sim
## vars n mean sd median trimmed mad min max range skew
## genero 1 54 1.31 0.47 1 1.27 0.00 1 2 1 0.78
## idade 2 54 33.33 14.12 28 30.91 5.93 20 69 49 1.46
## renda 3 54 3.52 1.11 4 3.61 1.48 1 5 4 -0.61
## escolaridade 4 54 6.00 0.95 6 5.93 1.48 4 8 4 0.39
## B_Esquerda* 5 54 2.00 0.00 2 2.00 0.00 2 2 0 NaN
## B_Direita* 6 54 1.00 0.00 1 1.00 0.00 1 1 0 NaN
## B_Controle* 7 54 1.00 0.00 1 1.00 0.00 1 1 0 NaN
## kurtosis se
## genero -1.42 0.06
## idade 0.66 1.92
## renda -0.18 0.15
## escolaridade -0.56 0.13
## B_Esquerda* NaN 0.00
## B_Direita* NaN 0.00
## B_Controle* NaN 0.00describeBy(data_perfil, group = data$B_Direita)##
## Descriptive statistics by group
## group: Não
## vars n mean sd median trimmed mad min max range skew
## genero 1 106 1.30 0.46 1 1.26 0.00 1 2 1 0.85
## idade 2 106 33.99 14.50 27 31.84 5.93 20 69 49 1.23
## renda 3 106 3.52 1.07 4 3.58 1.48 1 5 4 -0.39
## escolaridade 4 106 6.01 0.97 6 5.99 1.48 4 8 4 0.11
## B_Esquerda* 5 106 1.51 0.50 2 1.51 0.00 1 2 1 -0.04
## B_Direita* 6 106 1.00 0.00 1 1.00 0.00 1 1 0 NaN
## B_Controle* 7 106 1.49 0.50 1 1.49 0.00 1 2 1 0.04
## kurtosis se
## genero -1.29 0.04
## idade -0.04 1.41
## renda -0.38 0.10
## escolaridade -0.68 0.09
## B_Esquerda* -2.02 0.05
## B_Direita* NaN 0.00
## B_Controle* -2.02 0.05
## ------------------------------------------------------------
## group: Sim
## vars n mean sd median trimmed mad min max range skew
## genero 1 51 1.31 0.47 1 1.27 0.00 1 2 1 0.78
## idade 2 51 29.35 9.87 26 27.32 4.45 21 68 47 2.19
## renda 3 51 3.20 1.06 3 3.20 1.48 1 5 4 -0.19
## escolaridade 4 51 5.88 1.03 6 5.80 1.48 4 9 5 0.66
## B_Esquerda* 5 51 1.00 0.00 1 1.00 0.00 1 1 0 NaN
## B_Direita* 6 51 2.00 0.00 2 2.00 0.00 2 2 0 NaN
## B_Controle* 7 51 1.00 0.00 1 1.00 0.00 1 1 0 NaN
## kurtosis se
## genero -1.42 0.07
## idade 4.86 1.38
## renda -0.66 0.15
## escolaridade -0.19 0.14
## B_Esquerda* NaN 0.00
## B_Direita* NaN 0.00
## B_Controle* NaN 0.00describeBy(data_perfil, group = data$B_Controle)##
## Descriptive statistics by group
## group: Não
## vars n mean sd median trimmed mad min max range skew
## genero 1 105 1.31 0.47 1 1.27 0.00 1 2 1 0.79
## idade 2 105 31.40 12.35 27 28.74 4.45 20 69 49 1.82
## renda 3 105 3.36 1.09 3 3.41 1.48 1 5 4 -0.39
## escolaridade 4 105 5.94 0.99 6 5.87 1.48 4 9 5 0.53
## B_Esquerda* 5 105 1.51 0.50 2 1.52 0.00 1 2 1 -0.06
## B_Direita* 6 105 1.49 0.50 1 1.48 0.00 1 2 1 0.06
## B_Controle* 7 105 1.00 0.00 1 1.00 0.00 1 1 0 NaN
## kurtosis se
## genero -1.39 0.05
## idade 2.27 1.20
## renda -0.46 0.11
## escolaridade -0.33 0.10
## B_Esquerda* -2.02 0.05
## B_Direita* -2.02 0.05
## B_Controle* NaN 0.00
## ------------------------------------------------------------
## group: Sim
## vars n mean sd median trimmed mad min max range skew
## genero 1 52 1.29 0.46 1 1.24 0.00 1 2 1 0.91
## idade 2 52 34.67 15.00 27 32.81 5.93 20 66 46 0.99
## renda 3 52 3.52 1.04 3 3.55 1.48 1 5 4 -0.10
## escolaridade 4 52 6.02 1.00 6 6.05 1.48 4 8 4 -0.15
## B_Esquerda* 5 52 1.00 0.00 1 1.00 0.00 1 1 0 NaN
## B_Direita* 6 52 1.00 0.00 1 1.00 0.00 1 1 0 NaN
## B_Controle* 7 52 2.00 0.00 2 2.00 0.00 2 2 0 NaN
## kurtosis se
## genero -1.20 0.06
## idade -0.69 2.08
## renda -0.81 0.14
## escolaridade -0.85 0.14
## B_Esquerda* NaN 0.00
## B_Direita* NaN 0.00
## B_Controle* NaN 0.00Para os gráficos vamos reverter o one-hot-enconding para facilitar visualização
grupo <- as.data.frame(as.numeric(data_perfil$B_Esquerda))
grupo$B_Direita <- as.numeric(data_perfil$B_Direita)
grupo$B_Controle <- as.numeric(data_perfil$B_Controle)
colnames(grupo) <- c('Esquerda', 'Direita', 'Controle')
inds <- which(rowSums(grupo) == 1)
grupo$grupo <- toupper(names(grupo)[max.col(grupo)])
data_perfil <- cbind(data_perfil, grupo$grupo)
colnames(data_perfil)[8] <- 'Grupo'
data$Grupo <- factor(data_perfil$Grupo) # Incluir no conjunto de dados oficial para facilitar análises futuras5.1 Genero
data_perfil$genero <- factor(data_perfil$genero, levels = c(1,2), labels = c('Mulher', 'Homem'))
ggplot(data = data_perfil, aes(x = genero, fill = Grupo)) +
geom_bar() +
labs(y = 'Contagem', x = 'Gênero') +
theme_bw()
5.2 Histograma Idade
data_perfil$idade## [1] 24 24 25 28 26 27 56 23 34 26 27 23 31 34 28 25 28 56 30 65 28 20 27 28 25
## [26] 29 32 43 68 66 24 29 26 22 28 21 42 32 25 25 33 52 24 26 23 21 27 25 59 33
## [51] 65 66 60 27 62 26 65 26 48 24 22 21 22 24 27 25 36 63 33 21 27 21 24 23 40
## [76] 24 69 27 26 47 29 24 24 22 24 20 28 34 24 34 58 29 59 60 36 32 28 36 33 29
## [101] 35 24 25 23 29 23 28 26 25 29 31 25 64 55 20 57 61 66 37 21 24 39 28 34 22
## [126] 30 43 24 23 26 22 24 24 24 25 24 34 26 24 23 44 24 22 28 24 24 24 24 22 25
## [151] 25 27 25 22 46 27 63ggplot(data = data_perfil, aes(idade)) +
geom_histogram(aes(y = ..density..), colour = 'lightblue', fill = '#4682b4',
bins = 20) +
labs(x = 'Idade', y = 'Densidade') +
stat_function(fun = dnorm,
args = list(mean = mean(data_perfil$idade, na.rm = T),
sd = sd(data_perfil$idade, na.rm = T)),
colour = 'black', size = 1) +
theme_bw()
shapiro.test(data_perfil$idade) # Não é normal##
## Shapiro-Wilk normality test
##
## data: data_perfil$idade
## W = 0.74231, p-value = 2.71e-15ggplot(data = data_perfil, aes(x = idade, fill = Grupo)) +
geom_density(alpha = 0.3) +
labs(x = 'Idade', y = 'Densidade') +
theme_bw()
6 Questão 4
O posicionamento político da marca influencia a atitude em relação à marca? De que forma?
6.1 EFA Atitude
6.1.1 Requisitos e Nº de fatores Atitude
AtitudeCor <- cor(data[,c(3:12)], use = "pairwise.complete.obs") # Matriz de correlação
cortest.bartlett(AtitudeCor, n = nrow(data)) # ok ## $chisq
## [1] 1193.357
##
## $p.value
## [1] 1.524488e-220
##
## $df
## [1] 45KMO(AtitudeCor) # ok## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = AtitudeCor)
## Overall MSA = 0.92
## MSA for each item =
## atitude_1 atitude_2 atitude_3 atitude_4 atitude_5 atitude_6 atitude_7
## 0.92 0.52 0.91 0.95 0.94 0.91 0.91
## atitude_8 atitude_9 atitude_10
## 0.91 0.92 0.93(entulho <- scree(AtitudeCor))
## Scree of eigen values
## Call: NULL
## Eigen values of factors [1] 5.74 0.55 0.12 0.06 0.02 -0.06 -0.11 -0.13 -0.20 -0.25
## Eigen values of Principal Components [1] 6.06 1.26 0.67 0.56 0.38 0.33 0.26 0.19 0.17 0.12fa(AtitudeCor, cor = "poly")## Factor Analysis using method = minres
## Call: fa(r = AtitudeCor, cor = "poly")
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 h2 u2 com
## atitude_1 0.62 0.3809 0.62 1
## atitude_2 0.06 0.0036 1.00 1
## atitude_3 0.57 0.3194 0.68 1
## atitude_4 0.86 0.7382 0.26 1
## atitude_5 0.80 0.6322 0.37 1
## atitude_6 0.91 0.8193 0.18 1
## atitude_7 0.85 0.7168 0.28 1
## atitude_8 0.76 0.5755 0.42 1
## atitude_9 0.88 0.7667 0.23 1
## atitude_10 0.89 0.7835 0.22 1
##
## MR1
## SS loadings 5.74
## Proportion Var 0.57
##
## Mean item complexity = 1
## Test of the hypothesis that 1 factor is sufficient.
##
## The degrees of freedom for the null model are 45 and the objective function was 7.86
## The degrees of freedom for the model are 35 and the objective function was 0.89
##
## The root mean square of the residuals (RMSR) is 0.07
## The df corrected root mean square of the residuals is 0.08
##
## Fit based upon off diagonal values = 0.98
## Measures of factor score adequacy
## MR1
## Correlation of (regression) scores with factors 0.98
## Multiple R square of scores with factors 0.95
## Minimum correlation of possible factor scores 0.91nofactors <- fa.parallel(AtitudeCor, fm = "pa", fa = "fa", cor = "poly")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAsum(nofactors$fa.values > 1) # Critério Kaiser 1 (Componentes)## [1] 1sum(nofactors$fa.values > 0.7) # Critério Kaiser 0.7 (Fatores)## [1] 1entulho$pcv # Autovalores pelo critério Kaiser## [1] 6.0584484 1.2559499 0.6668754 0.5589752 0.3777777 0.3288555 0.2617802
## [8] 0.1915282 0.1748693 0.1249402entulho$fv # Autovalores pelo critério das linhas paralelas## [1] 5.73617379 0.54593247 0.11782753 0.06029355 0.01861954 -0.05996321
## [7] -0.10632430 -0.13407054 -0.19730648 -0.24500842irt.fa(AtitudeCor, plot = T)
## Item Response Analysis using Factor Analysis
##
## Call: irt.fa(x = AtitudeCor, plot = T)
## Item Response Analysis using Factor Analysis
##
## Summary information by factor and item
## Factor = 1
## -3 -2 -1 0 1 2 3
## atitude_1 0.06 0.07 0.07 0.06 0.05 0.03 0.02
## atitude_2 0.06 0.07 0.07 0.07 0.05 0.03 0.02
## atitude_3 0.06 0.07 0.07 0.07 0.05 0.03 0.02
## atitude_4 0.02 0.04 0.05 0.07 0.09 0.09 0.07
## atitude_5 0.02 0.03 0.03 0.04 0.04 0.04 0.04
## atitude_6 0.02 0.03 0.06 0.10 0.13 0.13 0.11
## atitude_7 0.02 0.03 0.06 0.10 0.13 0.13 0.11
## atitude_8 0.02 0.03 0.03 0.04 0.04 0.04 0.04
## atitude_9 0.02 0.04 0.05 0.07 0.09 0.09 0.07
## atitude_10 0.02 0.04 0.05 0.07 0.09 0.09 0.07
## Test Info 0.33 0.45 0.57 0.69 0.75 0.71 0.57
## SEM 1.74 1.49 1.32 1.21 1.15 1.19 1.33
## Reliability -2.03 -1.23 -0.75 -0.46 -0.33 -0.41 -0.76
##
## Factor analysis with Call: fa(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate,
## fm = fm)
##
## Test of the hypothesis that 1 factor is sufficient.
## The degrees of freedom for the model is 35 and the objective function was 23.24
## The number of observations was 10 with Chi Square = 96.84 with prob < 1e-07
##
## The root mean square of the residuals (RMSA) is 0.13
## The df corrected root mean square of the residuals is 0.15
##
## Tucker Lewis Index of factoring reliability = -0.379
## RMSEA index = 0.407 and the 10 % confidence intervals are 0.339 0.549
## BIC = 16.25dataAtitude <- data[,c(3:12)]6.1.2 Modelo EFA Atitude
EFA <- fa(dataAtitude,
nfactors = 1, # 1 fator
rotate = "promax", # Rotação oblíqua Promax
fm = "pa", # Fatoração pelo eixeo principal
scores = T,
missing = T,
impute = "mean",
oblique.scores = T,
cor = "poly", # Correlação Policórica
n.iter = 10)6.1.3 Métricas EFA Atitude
EFA$communality # Atitude 2 deveria ser removida## atitude_1 atitude_2 atitude_3 atitude_4 atitude_5 atitude_6
## 0.456331264 0.003585918 0.365499349 0.776882580 0.685874839 0.870168383
## atitude_7 atitude_8 atitude_9 atitude_10
## 0.763329012 0.668365900 0.805902205 0.844253281EFA$TLI # TLI ruim## [1] 0.8638314EFA$RMSEA # RMSEA ruim## RMSEA lower upper confidence
## 0.1654087 0.1429817 0.1899675 0.90000001-((EFA$STATISTIC-EFA$dof)/(EFA$null.chisq-EFA$null.dof))# CFI aceitável## [1] 0.8945707EFA$loadings # Definitivamente Atitude 2 não faz parte da estrutura fatorial, comprovado pela TRI##
## Loadings:
## PA1
## atitude_1 0.676
## atitude_2
## atitude_3 0.605
## atitude_4 0.881
## atitude_5 0.828
## atitude_6 0.933
## atitude_7 0.874
## atitude_8 0.818
## atitude_9 0.898
## atitude_10 0.919
##
## PA1
## SS loadings 6.240
## Proportion Var 0.624alpha(dataAtitude) ##
## Reliability analysis
## Call: alpha(x = dataAtitude)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.92 0.91 0.93 0.51 10 0.0087 4.2 1.4 0.56
##
## lower alpha upper 95% confidence boundaries
## 0.9 0.92 0.93
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## atitude_1 0.91 0.91 0.93 0.52 9.7 0.0090 0.083 0.65
## atitude_2 0.94 0.94 0.94 0.62 14.8 0.0068 0.019 0.65
## atitude_3 0.92 0.91 0.93 0.53 10.0 0.0089 0.083 0.65
## atitude_4 0.90 0.90 0.92 0.49 8.5 0.0105 0.071 0.54
## atitude_5 0.90 0.90 0.92 0.49 8.8 0.0101 0.077 0.54
## atitude_6 0.90 0.89 0.91 0.48 8.3 0.0111 0.069 0.54
## atitude_7 0.90 0.90 0.92 0.49 8.7 0.0104 0.068 0.55
## atitude_8 0.91 0.90 0.92 0.51 9.2 0.0098 0.070 0.55
## atitude_9 0.90 0.89 0.92 0.49 8.5 0.0106 0.068 0.55
## atitude_10 0.90 0.89 0.92 0.48 8.3 0.0107 0.071 0.54
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## atitude_1 157 0.69 0.70 0.658 0.62 5.1 1.6
## atitude_2 157 0.17 0.20 0.092 0.06 3.5 1.6
## atitude_3 157 0.63 0.66 0.602 0.56 4.6 1.3
## atitude_4 157 0.86 0.86 0.848 0.82 4.4 1.9
## atitude_5 157 0.82 0.82 0.803 0.77 3.5 1.8
## atitude_6 157 0.91 0.89 0.899 0.87 3.9 2.1
## atitude_7 157 0.85 0.83 0.828 0.80 4.3 2.1
## atitude_8 157 0.77 0.76 0.742 0.71 5.2 1.7
## atitude_9 157 0.87 0.86 0.860 0.83 4.3 2.0
## atitude_10 157 0.89 0.88 0.882 0.85 3.5 1.9
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 7 miss
## atitude_1 0.03 0.03 0.10 0.20 0.18 0.24 0.22 0
## atitude_2 0.13 0.17 0.17 0.27 0.15 0.08 0.03 0
## atitude_3 0.01 0.05 0.09 0.38 0.22 0.15 0.11 0
## atitude_4 0.11 0.07 0.11 0.20 0.19 0.15 0.17 0
## atitude_5 0.22 0.12 0.11 0.27 0.11 0.10 0.06 0
## atitude_6 0.21 0.11 0.11 0.14 0.15 0.10 0.18 0
## atitude_7 0.15 0.14 0.06 0.13 0.13 0.18 0.21 0
## atitude_8 0.06 0.04 0.04 0.15 0.20 0.22 0.29 0
## atitude_9 0.13 0.10 0.09 0.20 0.18 0.11 0.18 0
## atitude_10 0.24 0.10 0.11 0.25 0.13 0.06 0.10 0Vou manter Atitude 2 para não mudar o trabalho original, mas há problemas na questão
6.1.4 Score Atitude
data$Atitude <- as.vector(EFA$scores) # Concatenar n conjunto de dados original
data$Atitude## [1] -0.04264290 0.88464064 0.97460429 -0.50272556 -0.75311530 0.74999370
## [7] 0.84236317 -1.46218764 0.32224399 -1.26904709 -1.15284618 0.10017599
## [13] -0.10721476 1.03097880 1.07953061 0.54500473 0.73687096 -1.08808677
## [19] 0.62294593 0.43164601 1.76813864 -0.91415576 -0.98859770 -0.77235389
## [25] -1.85575397 0.59136267 0.26110844 1.61069926 1.24624443 1.32610374
## [31] -0.72424197 -1.99510370 -1.34796194 -0.06384519 -1.82289505 -1.28364802
## [37] -0.21342040 0.69057523 -0.13385990 -1.43758224 1.44005424 1.12742091
## [43] 0.94559872 -0.91813339 -1.89490494 -0.64785782 0.32250854 0.20547517
## [49] 1.76813864 0.63428883 -1.60056903 0.72834000 0.43116144 1.76813864
## [55] 1.16971893 -1.62265424 1.31917900 0.84148345 -0.32131332 -1.71428669
## [61] -1.38877332 -1.74698042 1.45854927 0.13475624 -0.99747494 -1.22213147
## [67] 0.98209094 0.44683473 1.49000473 -0.09527918 -1.69608739 0.75608167
## [73] -1.30623956 -0.31467736 0.41465878 -1.54728297 1.45378897 0.75184437
## [79] -1.77190265 -0.45450492 -0.22727273 0.27903111 0.50814242 -0.77534496
## [85] -1.67178414 -0.36735709 -1.40105835 1.54338816 1.18564989 -1.43044704
## [91] -1.15116082 -0.54552528 -0.72944464 -0.53577280 -0.44387580 1.61466590
## [97] 0.40049556 0.44258535 -1.36520108 -0.74532172 0.99448200 -1.57530690
## [103] 1.50997140 1.33899225 0.74780137 -0.42986162 0.58240971 -0.12253007
## [109] 0.27187774 0.24764492 -0.53666790 0.75507214 1.06568344 0.90700100
## [115] 1.01780919 -1.78003171 -0.26834471 1.76655134 0.21223767 1.48707800
## [121] -1.15259031 -1.07170175 1.76734499 0.69396852 -0.11690804 -0.19664183
## [127] 1.55280659 -0.95680658 -1.12176862 -0.26923183 0.09152404 -0.88843809
## [133] 0.23872157 -0.19580698 0.21015154 -0.32736885 -1.07798571 0.52607935
## [139] -1.01505651 0.83355829 0.62950810 0.27839851 -0.68302793 0.04505262
## [145] 0.71528036 0.18319066 0.26002257 1.59159668 0.24599431 -0.28125071
## [151] 0.01023342 -0.54352071 0.55618746 -0.21205610 -0.04082493 0.46569477
## [157] 1.26640202shapiro.test(data$Atitude) # p < 0.05, Pouco provável que seja normal##
## Shapiro-Wilk normality test
##
## data: data$Atitude
## W = 0.96801, p-value = 0.00105ggplot(data = data, aes(Atitude)) +
geom_histogram(aes(y = ..density..), colour = 'lightblue', fill = '#4682b4',
bins = 20) +
labs(x = 'Atitude', y = 'Densidade') +
theme_bw()
6.2 Teste de Kruskal-Wallis - Atitude
kruskal.test(Atitude ~ Grupo, data = data) ##
## Kruskal-Wallis rank sum test
##
## data: Atitude by Grupo
## Kruskal-Wallis chi-squared = 42.354, df = 2, p-value = 6.354e-10x² = 42.354, df = 2, p < 0.01, existe diferença entre os grupos
6.2.1 Tamanho de efeito: Eta2[H]
kruskal_effsize(data, data$Atitude ~ data$Grupo,
ci = T, nboot = 1000) # Eta2[H] = 0.262, Efeito Grande## [1] "All values of t are equal to 0.262036755759134 \n Cannot calculate confidence intervals"## # A tibble: 1 x 7
## .y. n effsize conf.low conf.high method magnitude
## * <chr> <int> <dbl> <list> <list> <chr> <ord>
## 1 data$Atitude 157 0.262 <NULL> <NULL> eta2[H] large6.2.2 Post-Hoc
options(scipen = 9999)
dunnTest(data$Atitude, data$Grupo, method = 'bonferroni')## Comparison Z P.unadj P.adj
## 1 CONTROLE - DIREITA 0.6978649 0.485261714107460 1.000000000000000
## 2 CONTROLE - ESQUERDA -5.2446847 0.000000156549826 0.000000469649479
## 3 DIREITA - ESQUERDA -5.9230382 0.000000003160474 0.000000009481422Não há diferença entre o grupo Controle ~ Direita (Z = 0.69, p.adj > 0.05) Há diferença entre o grupo Controle ~ Esquerda (Z = -5.24, p.adj < 0.01) Há diferença entre o grupo Direita ~ Esquerda (Z = -5.59, p.adj < 0.01)
ggplot(data, aes(x = Grupo, y = Atitude, fill = Grupo)) +
geom_violin(trim = F) +
stat_summary(fun.data = mean_sdl, fun.args = list(mult = 1),
geom = 'pointrange', color = 'white') +
labs(title = 'Atitude por Grupos', x = 'Grupos Experimentais',
y = 'Constructo Atitude', fill = 'Grupo') +
theme_bw()
6.3 Regressão linear
reg1 <- lm(Atitude ~ Grupo, data = data)
summary(reg1)##
## Call:
## lm(formula = Atitude ~ Grupo, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.11497 -0.62148 0.01443 0.69943 2.22157
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.2967 0.1217 -2.437 0.016 *
## GrupoDIREITA -0.1568 0.1730 -0.906 0.366
## GrupoESQUERDA 1.0106 0.1706 5.925 0.0000000197 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8779 on 154 degrees of freedom
## Multiple R-squared: 0.2641, Adjusted R-squared: 0.2545
## F-statistic: 27.63 on 2 and 154 DF, p-value: 0.00000000005581Mantendo o grupo CONTROLE como nível de referência, o resultado se igual aos resultados da anova, demonstrando não haver diferença para o grupo ‘Direita’ e uma diferença positiva para o grupo ‘Esquerda’
qplot(sample = Atitude, color = Grupo, data= data) +
labs(title = 'QQplot para os grupos') +
theme_bw()
Com base nos resultados é possível ver claramente que o posicionamento ‘Esquerda’ possui uma influência maior do que os demais, sendo esta diferença estatisticamente significativa
7 Questão 5
O posicionamento político da marca influencia a autenticidade percebida da marca? De que forma?
7.1 EFA - Autenticidade
AutenticidadeCor <- cor(data[,c(13:16)], use = 'pairwise.complete.obs')
cortest.bartlett(AutenticidadeCor, n = nrow(data)) # ok## $chisq
## [1] 272.9184
##
## $p.value
## [1] 0.00000000000000000000000000000000000000000000000000000005150738
##
## $df
## [1] 6KMO(AutenticidadeCor) # ok## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = AutenticidadeCor)
## Overall MSA = 0.8
## MSA for each item =
## autenticidade_1 autenticidade_2 autenticidade_3 autenticidade_4
## 0.80 0.78 0.80 0.86(entulho <- scree(AutenticidadeCor))
## Scree of eigen values
## Call: NULL
## Eigen values of factors [1] 2.38 0.06 0.01 -0.07
## Eigen values of Principal Components[1] 2.77 0.58 0.35 0.30fa(AutenticidadeCor, cor = "poly")## Factor Analysis using method = minres
## Call: fa(r = AutenticidadeCor, cor = "poly")
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 h2 u2 com
## autenticidade_1 0.81 0.66 0.34 1
## autenticidade_2 0.81 0.65 0.35 1
## autenticidade_3 0.83 0.69 0.31 1
## autenticidade_4 0.62 0.38 0.62 1
##
## MR1
## SS loadings 2.38
## Proportion Var 0.60
##
## Mean item complexity = 1
## Test of the hypothesis that 1 factor is sufficient.
##
## The degrees of freedom for the null model are 6 and the objective function was 1.77
## The degrees of freedom for the model are 2 and the objective function was 0.03
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.05
##
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy
## MR1
## Correlation of (regression) scores with factors 0.93
## Multiple R square of scores with factors 0.87
## Minimum correlation of possible factor scores 0.74nofactors <- fa.parallel(AutenticidadeCor, fm = "pa", fa = "fa", cor = "poly")
## Parallel analysis suggests that the number of factors = 1 and the number of components = NAsum(nofactors$fa.values > 1) # Critério Kaiser 1 (Componentes)## [1] 1sum(nofactors$fa.values > 0.7) # Critério Kaiser 0.7 (Fatores)## [1] 1entulho$pcv # Autovalores pelo critério Kaiser## [1] 2.7674841 0.5805100 0.3522632 0.2997426entulho$fv # Autovalores pelo critério das linhas paralelas## [1] 2.383827311 0.059454081 0.009375301 -0.068828777irt.fa(AtitudeCor, plot = T)
## Item Response Analysis using Factor Analysis
##
## Call: irt.fa(x = AtitudeCor, plot = T)
## Item Response Analysis using Factor Analysis
##
## Summary information by factor and item
## Factor = 1
## -3 -2 -1 0 1 2 3
## atitude_1 0.06 0.07 0.07 0.06 0.05 0.03 0.02
## atitude_2 0.06 0.07 0.07 0.07 0.05 0.03 0.02
## atitude_3 0.06 0.07 0.07 0.07 0.05 0.03 0.02
## atitude_4 0.02 0.04 0.05 0.07 0.09 0.09 0.07
## atitude_5 0.02 0.03 0.03 0.04 0.04 0.04 0.04
## atitude_6 0.02 0.03 0.06 0.10 0.13 0.13 0.11
## atitude_7 0.02 0.03 0.06 0.10 0.13 0.13 0.11
## atitude_8 0.02 0.03 0.03 0.04 0.04 0.04 0.04
## atitude_9 0.02 0.04 0.05 0.07 0.09 0.09 0.07
## atitude_10 0.02 0.04 0.05 0.07 0.09 0.09 0.07
## Test Info 0.33 0.45 0.57 0.69 0.75 0.71 0.57
## SEM 1.74 1.49 1.32 1.21 1.15 1.19 1.33
## Reliability -2.03 -1.23 -0.75 -0.46 -0.33 -0.41 -0.76
##
## Factor analysis with Call: fa(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate,
## fm = fm)
##
## Test of the hypothesis that 1 factor is sufficient.
## The degrees of freedom for the model is 35 and the objective function was 23.24
## The number of observations was 10 with Chi Square = 96.84 with prob < 0.0000001
##
## The root mean square of the residuals (RMSA) is 0.13
## The df corrected root mean square of the residuals is 0.15
##
## Tucker Lewis Index of factoring reliability = -0.379
## RMSEA index = 0.407 and the 10 % confidence intervals are 0.339 0.549
## BIC = 16.25dataAutenticidade <- data[,c(13:16)]7.1.1 Modelo EFA Autenticidade
EFA2 <- fa(dataAutenticidade,
nfactors = 1, # 1 fator
rotate = "promax", # Rotação oblíqua Promax
fm = "pa", # Fatoração pelo eixeo principal
scores = T,
missing = T,
impute = "mean",
oblique.scores = T,
cor = "poly", # Correlação Policórica
n.iter = 10)7.1.2 Métricas
EFA2$communality # Bom## autenticidade_1 autenticidade_2 autenticidade_3 autenticidade_4
## 0.7254528 0.7097586 0.7457163 0.4402883EFA2$TLI # TLI Bom## [1] 0.9416324EFA2$RMSEA # RMSEA ruim## RMSEA lower upper confidence
## 0.1446659 0.0559180 0.2510881 0.90000001-((EFA2$STATISTIC-EFA2$dof)/(EFA2$null.chisq-EFA2$null.dof))# CFI bom## [1] 0.9806299EFA2$loadings # Bom##
## Loadings:
## PA1
## autenticidade_1 0.852
## autenticidade_2 0.842
## autenticidade_3 0.864
## autenticidade_4 0.664
##
## PA1
## SS loadings 2.621
## Proportion Var 0.655alpha(dataAutenticidade) # bom##
## Reliability analysis
## Call: alpha(x = dataAutenticidade)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.85 0.85 0.82 0.59 5.7 0.019 3.3 0.89 0.6
##
## lower alpha upper 95% confidence boundaries
## 0.81 0.85 0.89
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## autenticidade_1 0.79 0.79 0.73 0.56 3.8 0.028 0.01140
## autenticidade_2 0.80 0.80 0.73 0.57 3.9 0.027 0.00489
## autenticidade_3 0.79 0.79 0.73 0.55 3.7 0.029 0.01346
## autenticidade_4 0.86 0.86 0.80 0.67 6.0 0.020 0.00038
## med.r
## autenticidade_1 0.55
## autenticidade_2 0.55
## autenticidade_3 0.51
## autenticidade_4 0.67
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## autenticidade_1 157 0.85 0.85 0.79 0.73 3.4 1.05
## autenticidade_2 157 0.86 0.85 0.79 0.72 3.6 1.12
## autenticidade_3 157 0.87 0.86 0.81 0.74 3.2 1.17
## autenticidade_4 157 0.74 0.76 0.62 0.57 3.0 0.94
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## autenticidade_1 0.06 0.09 0.38 0.31 0.17 0
## autenticidade_2 0.06 0.12 0.20 0.41 0.21 0
## autenticidade_3 0.08 0.22 0.25 0.31 0.13 0
## autenticidade_4 0.06 0.20 0.46 0.23 0.06 0data$Autenticidade <- as.vector(EFA2$scores)
data$Autenticidade## [1] -0.36396110 1.11538613 0.47671354 -0.09748642 -1.25749736 0.52957515
## [7] 1.75867992 -0.77037681 -0.78203081 -0.09748642 -0.39180434 -0.57299595
## [13] 0.69735941 -0.57299595 0.48832456 0.21023886 1.27155937 0.52957515
## [19] 1.42311141 0.05406562 1.75867992 -0.67168638 -1.83169732 -0.57299595
## [25] -1.00263370 0.52957515 0.37802311 0.78443882 0.69735941 1.01669571
## [31] -0.93816106 0.36179090 -1.42528162 0.22184988 -0.09748642 -0.83947064
## [37] -0.36396110 1.15663673 -0.53174536 0.43088473 1.59089567 0.52957515
## [43] 0.22184988 -2.16726583 -2.05234319 -0.35235008 1.75867992 -0.40521170
## [49] 1.75867992 -0.40521170 -2.48660213 1.01669571 0.52957515 1.75867992
## [55] 1.32442098 1.43934363 0.37340192 0.21023886 0.52957515 -0.93816106
## [61] -2.48660213 -0.27688170 0.22184988 0.54118617 -0.50390212 -0.36396110
## [67] 0.52957515 0.69735941 0.47671354 -0.54335638 0.61665456 1.75867992
## [73] 0.69735941 -0.36396110 0.54118617 -0.57299595 -0.78660902 1.42311141
## [79] -2.48660213 -0.40521170 -0.05623583 -0.93816106 0.26310047 -0.04462481
## [85] -1.69175630 -0.36396110 -0.26527068 1.00508469 0.97544511 -2.15103362
## [91] -0.15492625 -1.73300689 -0.19617685 0.12315945 0.21023886 1.28317039
## [97] -0.93816106 1.01669571 0.79604984 -1.42528162 0.80766086 -1.42528162
## [103] 0.49993558 1.11538613 0.52957515 -0.93816106 -0.61882477 0.52957515
## [109] 1.12000733 0.05406562 -0.49049477 -0.26527068 0.69735941 1.59089567
## [115] 1.10377511 -1.84792954 0.69735941 0.58705796 -0.22402008 0.48832456
## [121] -1.25749736 -1.13096370 -0.19617685 -0.21240906 -1.25749736 0.21023886
## [127] 1.28317039 -0.99102268 -0.83947064 -2.48660213 -0.40521170 -1.10594532
## [133] 0.65610882 -1.35160957 0.05406562 0.07029784 -0.36396110 0.38963413
## [139] -0.40521170 1.10377511 0.48832456 -0.39180434 0.04245460 -0.09748642
## [145] 0.79604984 0.07029784 0.22184988 0.69735941 0.37802311 0.69735941
## [151] 0.52957515 -1.47814323 -0.19617685 -0.83947064 0.69735941 0.22184988
## [157] 1.01669571shapiro.test(data$Autenticidade) # p < 0.05, Pouco provável que seja normal##
## Shapiro-Wilk normality test
##
## data: data$Autenticidade
## W = 0.97461, p-value = 0.005383ggplot(data = data, aes(Autenticidade)) +
geom_histogram(aes(y = ..density..), colour = 'lightblue', fill = '#4682b4',
bins = 20) +
labs(x = 'Autenticidade', y = 'Densidade') + theme_bw()
7.2 Teste de Kruskal-Wallis
kruskal.test(Autenticidade ~ Grupo, data = data) ##
## Kruskal-Wallis rank sum test
##
## data: Autenticidade by Grupo
## Kruskal-Wallis chi-squared = 21.298, df = 2, p-value = 0.00002373x² = 21.298, df = 2, p < 0.01, existe diferença entre os grupos
7.3 Tamanho de efeito: Eta2[H]
kruskal_effsize(data, data$Autenticidade ~ data$Grupo,
ci = T, nboot = 1000) # Eta2[H] = 0.125, Efeito Moderado## [1] "All values of t are equal to 0.125311301587562 \n Cannot calculate confidence intervals"## # A tibble: 1 x 7
## .y. n effsize conf.low conf.high method magnitude
## * <chr> <int> <dbl> <list> <list> <chr> <ord>
## 1 data$Autenticidade 157 0.125 <NULL> <NULL> eta2[H] moderate7.3.1 Post-Hoc
options(scipen = 9999)
dunnTest(data$Autenticidade, data$Grupo, method = 'bonferroni')## Comparison Z P.unadj P.adj
## 1 CONTROLE - DIREITA -0.6222287 0.53379147685 1.00000000000
## 2 CONTROLE - ESQUERDA -4.2667654 0.00001983275 0.00005949826
## 3 DIREITA - ESQUERDA -3.6175997 0.00029734782 0.00089204345Não há diferença entre o grupo Controle ~ Direita (Z = 0.69, p.adj > 0.05) Há diferença entre o grupo Controle ~ Esquerda (Z = -4.26, p.adj < 0.01) Há diferença entre o grupo Direita ~ Esquerda (Z = -3.61, p.adj < 0.01)
ggplot(data, aes(x = Grupo, y = Autenticidade, fill = Grupo)) +
geom_violin(trim = F) +
stat_summary(fun.data = mean_sdl, fun.args = list(mult = 1),
geom = 'pointrange', color = 'white') +
labs(title = 'Atitude por Grupos', x = 'Grupos Experimentais',
y = 'Constructo Autenticidade', fill = 'Grupo') +
theme_bw()
7.4 Regressão linear
reg2 <- lm(Autenticidade ~ Grupo, data = data)
summary(reg1) # Mantendo o grupo CONTROLE como nível de referência, o resultado se igual aos resultados da anova, demonstrando não haver diferença para o grupo 'Direita' e uma diferença positiva para o grupo 'Esquerda'##
## Call:
## lm(formula = Atitude ~ Grupo, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.11497 -0.62148 0.01443 0.69943 2.22157
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.2967 0.1217 -2.437 0.016 *
## GrupoDIREITA -0.1568 0.1730 -0.906 0.366
## GrupoESQUERDA 1.0106 0.1706 5.925 0.0000000197 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8779 on 154 degrees of freedom
## Multiple R-squared: 0.2641, Adjusted R-squared: 0.2545
## F-statistic: 27.63 on 2 and 154 DF, p-value: 0.00000000005581qplot(sample = Autenticidade, color = Grupo, data= data) +
labs(title = 'QQplot para os grupos') +
theme_bw()
8 Questão 6
O posicionamento político do respondente modera a relação entre o posicionamento político da marca e a atitude em relação à marca? Bônus: se a moderação for significante, faça uma análise de floodlight para verificar onde, exatamente, essa relação é significante.
## [1] "4" "5" "7" "3" "4" "3" "4" "2" "3" "5" "2" "4" "4" "6" "7" "3" "3" "3"
## [19] "3" "6" "2" "5" "3" "4" "3" "5" "5" "9" "9" "5" "3" "2" "2" "2" "4" "3"
## [37] "4" "4" "6" "1" "9" "4" "2" "2" "3" "6" "6" "5" "2" "3" "5" "7" "6" "8"
## [55] "6" "3" "8" "3" "4" "4" "2" "1" "1" "7" "2" "2" "3" "5" "3" "4" "3" "2"
## [73] "3" "5" "3" "2" "9" "3" "5" "3" "3" "5" "4" "2" "3" "3" "3" "5" "1" "5"
## [91] "8" "3" "7" "6" "2" "2" "3" "9" "2" "3" "7" "1" "4" "4" "3" "5" "7" "2"
## [109] "4" "6" "3" "2" "5" "1" "3" "5" "3" "" "8" "2" "2" "2" "2" "2" "7" "5"
## [127] "3" "3" "5" "5" "6" "4" "2" "5" "4" "7" "3" "4" "3" "4" "3" "7" "5" "4"
## [145] "4" "5" "4" "3" "3" "2" "4" "4" "7" "5" "5" "4" "2"RegMod <- lm(Atitude ~ Grupo * Posicionamento, data = data)
summ(RegMod)| Observations | 156 (1 missing obs. deleted) |
| Dependent variable | Atitude |
| Type | OLS linear regression |
| F(5,150) | 21.11 |
| R² | 0.41 |
| Adj. R² | 0.39 |
| Est. | S.E. | t val. | p | |
|---|---|---|---|---|
| (Intercept) | -0.57 | 0.30 | -1.91 | 0.06 |
| GrupoDIREITA | -1.17 | 0.39 | -3.03 | 0.00 |
| GrupoESQUERDA | 1.39 | 0.39 | 3.61 | 0.00 |
| Posicionamento | 0.06 | 0.07 | 0.83 | 0.41 |
| GrupoDIREITA:Posicionamento | 0.24 | 0.09 | 2.73 | 0.01 |
| GrupoESQUERDA:Posicionamento | -0.09 | 0.09 | -0.97 | 0.33 |
| Standard errors: OLS |
Existe um efeito de moderação entre as variáveis
interact_plot(RegMod, pred = Posicionamento, modx = Grupo)
Podemos ver que a interação somente é significativa e positiva para o grupo Direita
8.1 Spotlight / Floodlight
(Fiquei em dúvida em relação a spotlight, uma vez que ela é para uma interação de dados contínuos)
data$B_Esquerda2 <- ifelse(data$B_Esquerda == 'Não', 0,1)
regEsquerda <- lm(Atitude ~ Posicionamento*B_Esquerda2, data = data)
summary(regEsquerda)##
## Call:
## lm(formula = Atitude ~ Posicionamento * B_Esquerda2, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.14448 -0.49905 -0.01468 0.58502 2.09228
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.25439 0.19029 -6.592 0.000000000673 ***
## Posicionamento 0.21425 0.04309 4.972 0.000001769663 ***
## B_Esquerda2 2.08024 0.31545 6.595 0.000000000664 ***
## Posicionamento:B_Esquerda2 -0.24173 0.07034 -3.437 0.00076 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.805 on 152 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.377, Adjusted R-squared: 0.3647
## F-statistic: 30.66 on 3 and 152 DF, p-value: 0.00000000000000147data$B_Direita2 <- ifelse(data$B_Direita == 'Não', 0,1)
regDireita <- lm(Atitude ~ Posicionamento*B_Direita2, data = data)
summary(regDireita)##
## Call:
## lm(formula = Atitude ~ Posicionamento * B_Direita2, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.01164 -0.63995 0.03332 0.61456 2.33789
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.09825 0.21342 0.460 0.645896
## Posicionamento 0.02667 0.04937 0.540 0.589842
## B_Direita2 -1.83311 0.35259 -5.199 0.000000637 ***
## Posicionamento:B_Direita2 0.27729 0.07735 3.585 0.000454 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8964 on 152 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.2276, Adjusted R-squared: 0.2123
## F-statistic: 14.93 on 3 and 152 DF, p-value: 0.00000001446