paperdraft
2024-05-31
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(readxl)
library(texreg)## Version: 1.39.3
## Date: 2023-11-09
## Author: Philip Leifeld (University of Essex)
##
## Consider submitting praise using the praise or praise_interactive functions.
## Please cite the JSS article in your publications -- see citation("texreg").Survey <- read_excel("SurveyFinal.xlsx", sheet = "Sheet0")
head(Survey)## # A tibble: 6 × 21
## acepto edad genero pref_partidos candidatos voto competente_c_1 lider_c_1
## <chr> <chr> <chr> <chr> <chr> <chr> <dbl> <dbl>
## 1 Acepto 20 Femenino No tengo nin… Jorge Álv… Xóch… 3 3
## 2 Acepto 20 Femenino No tengo nin… Jorge Álv… Xóch… 4 3
## 3 Acepto 23 Femenino No tengo nin… Jorge Álv… Anul… 4 3
## 4 Acepto 21 Masculino No tengo nin… Jorge Álv… Xóch… NA NA
## 5 Acepto 23 Femenino No tengo nin… Jorge Álv… Xóch… NA 4
## 6 Acepto 22 Femenino PAN Jorge Álv… Xóch… NA NA
## # ℹ 13 more variables: amigable_c_1 <dbl>, honesto_c_1 <dbl>,
## # empatico_c_1 <dbl>, sentimientos_c_1 <dbl>, competente_t_1 <dbl>,
## # lider_t_1 <dbl>, amigable_t_1 <dbl>, honesto_t_1 <dbl>, empatico_t_1 <dbl>,
## # sentimientos_t_1 <dbl>, maynezmaynez <chr>, ultima <chr>, Music <chr>#Clean database
Clean_Surv = Survey%>%
mutate(Music = as.factor(Music))%>%
mutate(edad = as.numeric(edad))%>%
mutate(competente_c = as.numeric(competente_c_1))%>%
mutate(lider_c = as.numeric(lider_c_1))%>%
mutate(amigable_c = as.numeric(amigable_c_1))%>%
mutate(honesto_c = as.numeric(honesto_c_1))%>%
mutate(empatico_c = as.numeric(empatico_c_1))%>%
mutate(sentimientos_c = as.numeric(sentimientos_c_1))%>%
mutate(competente_t = as.numeric(competente_t_1))%>%
mutate(lider_t = as.numeric(lider_t_1))%>%
mutate(amigable_t = as.numeric(amigable_t_1))%>%
mutate(honesto_t = as.numeric(honesto_t_1))%>%
mutate(empatico_t = as.numeric(empatico_t_1))%>%
mutate(sentimientos_t = as.numeric(sentimientos_t_1))%>%
mutate(candidatos = ifelse(candidatos == "Jorge Álvarez Máynez,Xóchitl Gálvez Ruiz,Claudia Sheinbaum Pardo", "Sí sabe", "No sabe"))%>%
mutate(pref_partido = ifelse(pref_partidos == "Movimiento Ciudadano", "Simpatizantes", "No simpatizantes"))%>%
mutate(maynezmaynez = as.factor(maynezmaynez))%>%
mutate(voto = ifelse(voto == "Jorge Álvarez Máynez", "Simpatizantes","No simpatizantes"))%>%
select(edad, genero, pref_partido, candidatos, voto, competente_c, lider_c, amigable_c, honesto_c, empatico_c, sentimientos_c, competente_t, lider_t, amigable_t, honesto_t, empatico_t, sentimientos_t, maynezmaynez, Music)General statistics
age_mean = mean(Clean_Surv$edad)
age_mean## [1] 21.75269age_sd = sd(Clean_Surv$edad)
age_sd## [1] 2.509356print(c(age_mean,age_sd))## [1] 21.752688 2.509356conteo_genero <- table(Clean_Surv$genero)
proporcion_genero <- prop.table(conteo_genero)
print(proporcion_genero)##
## Femenino Masculino No binario/ tercer género
## 0.54838710 0.44086022 0.01075269print(conteo_genero)##
## Femenino Masculino No binario/ tercer género
## 51 41 1conteo_grupos <- table(Clean_Surv$Music)
names(conteo_grupos) <- c("Control", "Treatment")
print(conteo_grupos)## Control Treatment
## 50 43proporcion_grupos = prop.table(conteo_grupos)
print(proporcion_grupos)## Control Treatment
## 0.5376344 0.4623656# Mean and standard dev (traits)
competence_mean <- mean(c(Clean_Surv$competente_c, Clean_Surv$competente_t), na.rm = TRUE)
competence_sd <- sd(c(Clean_Surv$competente_c, Clean_Surv$competente_t), na.rm = TRUE)
leadership_mean <- mean(c(Clean_Surv$lider_c, Clean_Surv$lider_t), na.rm = TRUE)
leadership_sd <- sd(c(Clean_Surv$lider_c, Clean_Surv$lider_t), na.rm = TRUE)
friendliness_mean <- mean(c(Clean_Surv$amigable_c, Clean_Surv$amigable_t), na.rm = TRUE)
friendliness_sd <- sd(c(Clean_Surv$amigable_c, Clean_Surv$amigable_t), na.rm = TRUE)
honest_mean <- mean(c(Clean_Surv$honesto_c, Clean_Surv$honesto_t), na.rm = TRUE)
honest_sd <- sd(c(Clean_Surv$honesto_c, Clean_Surv$honesto_t), na.rm = TRUE)
empathic_mean <- mean(c(Clean_Surv$empatico_c, Clean_Surv$empatico_t), na.rm = TRUE)
empathic_sd <- sd(c(Clean_Surv$empatico_c, Clean_Surv$empatico_t), na.rm = TRUE)
sentiments_mean <- mean(c(Clean_Surv$sentimientos_c, Clean_Surv$sentimientos_t), na.rm = TRUE)
sentiments_sd <- sd(c(Clean_Surv$sentimientos_c, Clean_Surv$sentimientos_t), na.rm = TRUE)
results <- data.frame(
Trait = c("Competence", "Leadership", "Friendliness", "Honesty", "Empathy", "Sentiments"),
Mean = c(competence_mean, leadership_mean, friendliness_mean, honest_mean, empathic_mean, sentiments_mean),
SD = c(competence_sd, leadership_sd, friendliness_sd, honest_sd, empathic_sd, sentiments_sd)
)
print(results)## Trait Mean SD
## 1 Competence 3.351648 0.9817629
## 2 Leadership 2.910112 0.8344902
## 3 Friendliness 4.091954 0.8576900
## 4 Honesty 2.955056 0.6893692
## 5 Empathy 3.444444 0.8494692
## 6 Sentiments 5.943182 2.1674603Regression model
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.4
## ✔ ggplot2 3.4.4 ✔ stringr 1.5.0
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ tidyr::extract() masks texreg::extract()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors# Nueva base con columnas por grupos, preguntas y respuestas (6 filas por cada encuestado)
encuesta_long <- Clean_Surv %>%
pivot_longer(cols = c(competente_c, lider_c, amigable_c, honesto_c, empatico_c, sentimientos_c,
competente_t, lider_t, amigable_t, honesto_t, empatico_t, sentimientos_t),
names_to = c("pregunta", "grupo"),
names_sep = "_",
values_to = "respuesta") %>%
mutate(grupo = ifelse(grupo == "t", "tratamiento", "control"),
grupo = as.factor(grupo))
# lista vacia para poner los modelos
modelos <- list()
for (preg in unique(encuesta_long$pregunta)) {
datos_pregunta <- encuesta_long %>% filter(pregunta == preg)
modelo <- lm(respuesta ~ grupo, data = datos_pregunta)
modelos[[preg]] <- modelo
cat("\nResumen del modelo para", preg, ":\n")
print(summary(modelo))
}##
## Resumen del modelo para competente :
##
## Call:
## lm(formula = respuesta ~ grupo, data = datos_pregunta)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5208 -0.5208 -0.1628 0.8372 1.8372
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.5208 0.1401 25.133 <2e-16 ***
## grupotratamiento -0.3580 0.2038 -1.757 0.0824 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9706 on 89 degrees of freedom
## (95 observations deleted due to missingness)
## Multiple R-squared: 0.03352, Adjusted R-squared: 0.02266
## F-statistic: 3.087 on 1 and 89 DF, p-value: 0.08238
##
##
## Resumen del modelo para lider :
##
## Call:
## lm(formula = respuesta ~ grupo, data = datos_pregunta)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.93617 -0.88095 0.06383 0.11905 2.11905
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.93617 0.12235 24.00 <2e-16 ***
## grupotratamiento -0.05522 0.17811 -0.31 0.757
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8388 on 87 degrees of freedom
## (97 observations deleted due to missingness)
## Multiple R-squared: 0.001104, Adjusted R-squared: -0.01038
## F-statistic: 0.09611 on 1 and 87 DF, p-value: 0.7573
##
##
## Resumen del modelo para amigable :
##
## Call:
## lm(formula = respuesta ~ grupo, data = datos_pregunta)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.90244 -0.26087 0.09756 0.73913 1.09756
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.2609 0.1244 34.260 <2e-16 ***
## grupotratamiento -0.3584 0.1812 -1.978 0.0511 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8435 on 85 degrees of freedom
## (99 observations deleted due to missingness)
## Multiple R-squared: 0.04402, Adjusted R-squared: 0.03278
## F-statistic: 3.914 on 1 and 85 DF, p-value: 0.05112
##
##
## Resumen del modelo para honesto :
##
## Call:
## lm(formula = respuesta ~ grupo, data = datos_pregunta)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.02083 -0.02083 -0.02083 0.12195 2.12195
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.02083 0.09953 30.351 <2e-16 ***
## grupotratamiento -0.14278 0.14664 -0.974 0.333
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6896 on 87 degrees of freedom
## (97 observations deleted due to missingness)
## Multiple R-squared: 0.01078, Adjusted R-squared: -0.0005905
## F-statistic: 0.9481 on 1 and 87 DF, p-value: 0.3329
##
##
## Resumen del modelo para empatico :
##
## Call:
## lm(formula = respuesta ~ grupo, data = datos_pregunta)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4 -0.5 0.5 0.6 1.6
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.4000 0.1206 28.191 <2e-16 ***
## grupotratamiento 0.1000 0.1809 0.553 0.582
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8528 on 88 degrees of freedom
## (96 observations deleted due to missingness)
## Multiple R-squared: 0.00346, Adjusted R-squared: -0.007864
## F-statistic: 0.3056 on 1 and 88 DF, p-value: 0.5818
##
##
## Resumen del modelo para sentimientos :
##
## Call:
## lm(formula = respuesta ~ grupo, data = datos_pregunta)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.9796 -0.9796 0.1026 1.3320 4.0204
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.97959 0.31138 19.204 <2e-16 ***
## grupotratamiento -0.08216 0.46773 -0.176 0.861
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.18 on 86 degrees of freedom
## (98 observations deleted due to missingness)
## Multiple R-squared: 0.0003586, Adjusted R-squared: -0.01127
## F-statistic: 0.03085 on 1 and 86 DF, p-value: 0.861screenreg(modelos)##
## ======================================================================================
## competente lider amigable honesto empatico sentimientos
## --------------------------------------------------------------------------------------
## (Intercept) 3.52 *** 2.94 *** 4.26 *** 3.02 *** 3.40 *** 5.98 ***
## (0.14) (0.12) (0.12) (0.10) (0.12) (0.31)
## grupotratamiento -0.36 -0.06 -0.36 -0.14 0.10 -0.08
## (0.20) (0.18) (0.18) (0.15) (0.18) (0.47)
## --------------------------------------------------------------------------------------
## R^2 0.03 0.00 0.04 0.01 0.00 0.00
## Adj. R^2 0.02 -0.01 0.03 -0.00 -0.01 -0.01
## Num. obs. 91 89 87 89 90 88
## ======================================================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05#Regression model +vote +parties
library(tidyverse)
# Nueva base con columnas por grupos, preguntas y respuestas (6 filas por cada encuestado)
encuesta_long <- Clean_Surv %>%
pivot_longer(cols = c(competente_c, lider_c, amigable_c, honesto_c, empatico_c, sentimientos_c,
competente_t, lider_t, amigable_t, honesto_t, empatico_t, sentimientos_t),
names_to = c("pregunta", "grupo"),
names_sep = "_",
values_to = "respuesta") %>%
mutate(grupo = ifelse(grupo == "t", "tratamiento", "control"),
grupo = as.factor(grupo))
# lista vacia para poner los modelos
modelos <- list()
for (preg in unique(encuesta_long$pregunta)) {
datos_pregunta <- encuesta_long %>% filter(pregunta == preg)
modelo <- lm(respuesta ~ grupo + voto + pref_partido, data = datos_pregunta)
modelos[[preg]] <- modelo
}
# Resumen de los modelos utilizando screenreg
screenreg(modelos)##
## ===============================================================================================
## competente lider amigable honesto empatico sentimientos
## -----------------------------------------------------------------------------------------------
## (Intercept) 3.32 *** 2.81 *** 4.16 *** 2.88 *** 3.24 *** 5.51 ***
## (0.14) (0.13) (0.13) (0.10) (0.12) (0.31)
## grupotratamiento -0.29 -0.03 -0.33 -0.10 0.14 0.03
## (0.19) (0.17) (0.18) (0.14) (0.17) (0.44)
## votoSimpatizantes 0.66 * 0.45 0.14 0.61 ** 0.56 * 1.75 **
## (0.27) (0.25) (0.25) (0.19) (0.24) (0.60)
## pref_partidoSimpatizantes 0.63 0.45 0.62 0.15 0.48 1.14
## (0.36) (0.35) (0.33) (0.26) (0.32) (0.81)
## -----------------------------------------------------------------------------------------------
## R^2 0.17 0.09 0.10 0.15 0.12 0.16
## Adj. R^2 0.14 0.06 0.07 0.12 0.09 0.13
## Num. obs. 91 89 87 89 90 88
## ===============================================================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05#Effect size plot
library(dplyr)
library(ggplot2)
model_results <- data.frame(
response = c("competente", "lider", "amigable", "honesto", "empatico", "sentimientos"),
estimate = c(-0.36, -0.06, -0.36, -0.14, 0.10, -0.08),
std_error = c(0.20, 0.18, 0.18, 0.15, 0.18, 0.47)
)
model_results <- model_results %>%
mutate(lower_ci = estimate - 1.96 * std_error,
upper_ci = estimate + 1.96 * std_error)
ggplot(model_results, aes(x = response, y = estimate)) +
geom_point() +
geom_errorbar(aes(ymin = lower_ci, ymax = upper_ci), width = 0.2) +
geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
labs(title = "Music and Candidate Support - Effect Size Plot", x = "Perception Traits", y = "Estimate (with 95% CI)") +
theme_minimal()