adq <- read_rds("adq_ri24.rds")Actividad R5
Actividad 1: Experimentos y causalidad (25% de la nota del Reto)
Hemos utilizado dos tipos de gráficos para presentar los datos, por un lado el gráfico de dispersión y posteriormente el gráfico de barras.
Gráfico de dispersión
- Los puntos muestran la variación de la variable Outcome en función del grupo de tratamiento (
T1= 1 tratamiento vsT1= 0 control). - El gráfico muestra la media de Outcome para cada grupo (T1 = 0 y T1 = 1), además del intervalo de confianza del 95% en color rojo, de esta manera comparamos la media de la propensión a realizar un TFG cuantitativo entre los dos grupos.
adq |>
ggplot(aes(x = T1, y = Outcome, color = factor(T1))) +
geom_point(position = position_jitter(width = .01, height = 0.2)) +
stat_summary(geom = "pointrange", fun.data = mean_se, col= "red", size = 0.8,
fun.args = list(mult = 1.96))
Gráfico de barras
En este gráfico de barras vemos como el eje X nos muestra las categorías de la variable T1. Donde, T1=1 es el grupo con tratamiento y T1= 0 el grupo de control. Por el otro lado, el eje Y nos muestra los valores para la variable Outcome para cada grupo de T1.
ggplot(adq, aes(x = factor(T1), fill = factor(Outcome))) +
geom_bar(position = "fill") +
labs(x = "Grupo de tratamiento", y = "Proporción", fill = "Resultado") +
theme_minimal()
En ambos gráficos vemos que los valores son similares para ambos grupos. Esto nos indica que no existe asociación entre la exposición a la información y una mayor propensión a realizar un TFG cuantitativo.
Como para ambos grupos lo valores son muy similares no existe evidencia de que la variable T1=1 tenga efecto causal sobre el resultado Outcome. Por lo tanto, la hipótesis H1: “Los estudiantes más expuestos a las virtudes del análisis cuantitativo tienden a querer realizar un Trabajo Final de Grado cuantitativo” no se cumple.
Comprobamos con los siguientes gráficos que no hay una diferencia significativa entre ambos grupos. Para ello, estudiamos como que el azar ha repartido el tratamiento de forma similar entre grupos centrandonos en la distribución por edad.
Distribución de edad por Grupo de Tratamiento:
En el gráfico que vemos a continuación, vemos como ambos grupos tanto T1=0 y T1=1 tienen distribuciones similares en cada categoría de edad. Cabe destacar que el grupo T1=0 tiene estudiantes por encima de los 60 años, cosa que no sucede en el grupo T1= 1. Para el resto de grupos de edades ambos grupos tienen una distribución similar.
Esta distribución similar nos indica que el azar ha organizado a los participantes de manera balanceada en términos de edad y que por lo tanto no existe diferencia significativa entre ambos casos.
ggplot(adq, aes(x = factor(T1), y = Edad)) +
geom_boxplot(fill = "lightblue") +
labs(title = "Distribución de la edad por grupo de tratamiento",
x = "Grupo de tratamiento (T1)",
y = "Edad") +
theme_minimal()
Propensión a hacer un TFG cuantitativo por edad
En el gráfico inferior vemos la distribución por edades de la propensión a hacer un TFG cuantitativo. Hemos añadido este gráfico para evaluar si la edad tiene un efecto causal a la hora de realizar TFG cuantitativos y de esta manera apoyar los resultados del gráfico sobre la distribución de edad por Grupo de Tratamiento.
Los resultados del gráfico inferior nos muestran que los rangos de años más altos (45-59 y mayores de 60) tienen una propensión mayor de realizar un TFG cuantitativo. Sin embargo, los grupos de edades entre 18-29 y 20-44 tiene un promedio menor. Esto nos puede indicar que la edad tiene un efecto sobre la propensión a realizar un TFG cuantitativo.
boxplot(Outcome ~ Edad, data = adq, main = "Propensión a hacer TFG cuantitativo por Edad", ylab = "Propensión a hacer TFG cuantitativo", xlab = "Edad")
En conclusión, las variables en ambos grupos están distribuidas de manera similar y por lo tanto la no existe diferencia significativa. Sin embargo, como hay una influencia de la edad en la propensión a realizar el TFG cuantitativo, es importante incluir la edad como una variable de control en el análisis causal.
Actividad 2: Interpretar un análisis cuantitativo (25% de la nota del Reto)
Estudiando la tabla de modelos que vemos en la Figura 1, vemos que la variable dependiente en M1 y M2 es “National Identification” y para M3 y M4 es “Regional Identification”
A continuación, vemos la interpretación del significado de la variable Post-Invasion para cada uno de los modelos. Para el modelo M1, el coeficiente es 0.64 esto nos indica que para las personas encuestadas después de la invasión rusa de Ucrania existe un aumento en la identificación nacional de 0.64 puntos respecto de las encuestadas pre-invasión. El nivel de significancia (p < 0.001) para este coeficiente nos muestra que existe una probabilidad muy baja (<0.1%) de que el efecto estimado se deba al azar. Esto nos indica que la invasión ha tenido un efecto significativo en la medida de la identificación nacional de las personas encuestadas post invasión.
Para el modelo M2, ese mismo coeficiente es de 0.56 (p < 0.001), muestra lo mismo que en M1 pero en este modelo se han incluido controles de edad, ingresos, ideología, sexo y educación que nos e habían incluido en M1.
Para el modelo M3 el coeficiente es de 0.04, este valor no es significativo y nos indica que la invasión no ha tenido un efecto significativo en la identificación regional de las personas encuesta post -invasión.
Para el modelo M4, el coeficiente es de -0.12, lo que indica tal y como en el modelo M3 que la invacion no ha afectado a la identifciation regional. En este modelo M4, se han incluido controles de edad, ingresos, ideología, sexo y educación que nos e habían incluido en M3.
Ahora comentaremos los coeficientes vinculados a dos de las variables de control. La ideología es una de estas variables. Vemos que para el modelo M2, el coeficiente de 0.37 nos indica que una mayor ideología política está asociada a un incremento de la identificación nacional. Esta misa variable para el modelo M4 tiene un valor de 0.05, mucho menor que para M2, lo que nos indica que el efecto de la ideología es menor para la identificación regional.
Otra variable de control es la educación. Vemos que para ambos modelos el coeficiente es negativo (-0.24 para M2 y -0.29 para M4) esto nos indica que a mayor nivel educativo la identificación nacional (para M2) y la identificación regional (para M4) disminuyen. En ambos modelos la educación tiene una p < 0.001, lo que significa que el efecto es muy significativo.
Comparando los modelo M1 y M2 vemos que el modelo M2 captura mejor la variación de la variable dependiente ya que el modelo M2 tiene un valor de R2 ajustado de 0.213 mientras que el M1 tiene un valor de R2 ajustado de 0.007 (un valor de R2 ajustado mayor (maximo valor es 1) nos indica que el modelo explica una gran parte de la variación de la variable dependiente).
Actividad 3: Análisis de regresión (25% de la nota del Reto)
A continuación hemos creado una tabla con varios modelos de regresión, con la misma variable dependiente: apoyo a un gobierno militar. Hemos creado 4 modelos, presentados a continuación.
load("all.RData")Modelo 1: Variable que distingue el grupo de tratamiento y el de control.
modelo1 <- lm(military_gov ~ treat, data = all)
summary(modelo1)
Call:
lm(formula = military_gov ~ treat, data = all)
Residuals:
Min 1Q Median 3Q Max
-0.2778 -0.2778 -0.2754 0.7222 0.7246
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.277778 0.039998 6.945 2.98e-11 ***
treat -0.002415 0.055322 -0.044 0.965
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.449 on 262 degrees of freedom
Multiple R-squared: 7.276e-06, Adjusted R-squared: -0.003809
F-statistic: 0.001906 on 1 and 262 DF, p-value: 0.9652Modelo 2: Variable que mide preferencias de apoyo a un gobierno militar medida en la primera encuesta (la variable tiene que empezar por pre_).
modelo2 <- lm(military_gov ~ pre_military_gov, data = all)
summary(modelo2)
Call:
lm(formula = military_gov ~ pre_military_gov, data = all)
Residuals:
Min 1Q Median 3Q Max
-0.7750 -0.0618 -0.0618 0.2250 0.9382
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.06180 0.02308 2.678 0.00789 **
pre_military_gov 0.71320 0.04144 17.208 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.3079 on 256 degrees of freedom
(6 observations deleted due to missingness)
Multiple R-squared: 0.5363, Adjusted R-squared: 0.5345
F-statistic: 296.1 on 1 and 256 DF, p-value: < 2.2e-16Modelo 3: Las dos variables.
modelo3 <- lm(military_gov ~ treat + pre_military_gov, data = all)
summary(modelo3)
Call:
lm(formula = military_gov ~ treat + pre_military_gov, data = all)
Residuals:
Min 1Q Median 3Q Max
-0.83384 -0.10622 -0.01208 0.16616 0.98792
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.10622 0.02916 3.642 0.000327 ***
treat -0.09414 0.03838 -2.452 0.014858 *
pre_military_gov 0.72761 0.04146 17.548 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.3049 on 255 degrees of freedom
(6 observations deleted due to missingness)
Multiple R-squared: 0.547, Adjusted R-squared: 0.5435
F-statistic: 154 on 2 and 255 DF, p-value: < 2.2e-16Modelo 4: Las dos variables más controles de sexo, edad y de si se tienen familiares víctimas de la represión.
modelo4 <- lm(military_gov ~ treat + pre_military_gov + base_gender + age + v, data = all)
summary(modelo4)
Call:
lm(formula = military_gov ~ treat + pre_military_gov + base_gender +
age + v, data = all)
Residuals:
Min 1Q Median 3Q Max
-0.86487 -0.08725 -0.04246 0.09208 1.01388
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.309705 0.156695 1.976 0.04921 *
treat -0.099895 0.038193 -2.616 0.00945 **
pre_military_gov 0.723014 0.041554 17.399 < 2e-16 ***
base_gender -0.098888 0.038710 -2.555 0.01123 *
age -0.001234 0.006800 -0.181 0.85616
v -0.043055 0.044685 -0.964 0.33622
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.3003 on 248 degrees of freedom
(10 observations deleted due to missingness)
Multiple R-squared: 0.5628, Adjusted R-squared: 0.554
F-statistic: 63.86 on 5 and 248 DF, p-value: < 2.2e-16Recopilación de los 4 modelos:
library(stargazer)
stargazer(modelo1, modelo2, modelo3, modelo4, type = "text",
title = "Resultados de los Modelos de Regresión",
digits = 3)
Resultados de los Modelos de Regresión
=================================================================================================================
Dependent variable:
---------------------------------------------------------------------------------------------
military_gov
(1) (2) (3) (4)
-----------------------------------------------------------------------------------------------------------------
treat -0.002 -0.094** -0.100***
(0.055) (0.038) (0.038)
pre_military_gov 0.713*** 0.728*** 0.723***
(0.041) (0.041) (0.042)
base_gender -0.099**
(0.039)
age -0.001
(0.007)
v -0.043
(0.045)
Constant 0.278*** 0.062*** 0.106*** 0.310**
(0.040) (0.023) (0.029) (0.157)
-----------------------------------------------------------------------------------------------------------------
Observations 264 258 258 254
R2 0.00001 0.536 0.547 0.563
Adjusted R2 -0.004 0.535 0.543 0.554
Residual Std. Error 0.449 (df = 262) 0.308 (df = 256) 0.305 (df = 255) 0.300 (df = 248)
F Statistic 0.002 (df = 1; 262) 296.130*** (df = 1; 256) 153.973*** (df = 2; 255) 63.858*** (df = 5; 248)
=================================================================================================================
Note: *p<0.1; **p<0.05; ***p<0.01La variable que distingue tratamiento de control tiene valores diferentes en los coeficientes y en los niveles de significación en los distintos modelos debido a las variables de control que se añaden en cada modelo.
Como no se controla mediante ninguna variables, el efecto de treat es muy pequeño. Pero una vez se van añadiendo variables que explican la variabilidad en military_gov, el coeficiente de treat se hace más significativo. Esto nos indica que el tratamiento tiene un efecto que puede ser captado al controlar las otras características de los individuos en la muestra.
derecha <- filter(all, pre_ideology_1 > 5)
izquierda <- filter(all, pre_ideology_1 <= 5)Tabla: Resultados para los individuos de derechas
modelo_derecha1 <- lm(military_gov ~ treat, data = derecha)
modelo_derecha2 <- lm(military_gov ~ pre_military_gov, data = derecha)
modelo_derecha3 <- lm(military_gov ~ treat + pre_military_gov, data = derecha)
modelo_derecha4 <- lm(military_gov ~ treat + pre_military_gov + base_gender + age + v, data = derecha)
stargazer(modelo_derecha1, modelo_derecha2, modelo_derecha3, modelo_derecha4, type = "text",
title = "Resultados de los Modelos para Individuos de Derecha",
digits = 3)
Resultados de los Modelos para Individuos de Derecha
===========================================================================================================
Dependent variable:
---------------------------------------------------------------------------------------
military_gov
(1) (2) (3) (4)
-----------------------------------------------------------------------------------------------------------
treat -0.095 -0.131* -0.118
(0.107) (0.074) (0.075)
pre_military_gov 0.736*** 0.750*** 0.756***
(0.078) (0.077) (0.077)
base_gender -0.042
(0.075)
age -0.0001
(0.011)
v 0.008
(0.120)
Constant 0.676*** 0.143** 0.213*** 0.273
(0.084) (0.064) (0.074) (0.256)
-----------------------------------------------------------------------------------------------------------
Observations 89 86 86 83
R2 0.009 0.517 0.534 0.559
Adjusted R2 -0.002 0.511 0.523 0.531
Residual Std. Error 0.489 (df = 87) 0.338 (df = 84) 0.334 (df = 83) 0.331 (df = 77)
F Statistic 0.786 (df = 1; 87) 89.768*** (df = 1; 84) 47.624*** (df = 2; 83) 19.547*** (df = 5; 77)
===========================================================================================================
Note: *p<0.1; **p<0.05; ***p<0.01Tabla: Resultados para los individuos de izquierdas
modelo_izquierda1 <- lm(military_gov ~ treat, data = izquierda)
summary(modelo_izquierda1)
Call:
lm(formula = military_gov ~ treat, data = izquierda)
Residuals:
Min 1Q Median 3Q Max
-0.13187 -0.13187 -0.07229 -0.07229 0.92771
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.13187 0.03196 4.127 5.73e-05 ***
treat -0.05958 0.04627 -1.288 0.2
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.3048 on 172 degrees of freedom
Multiple R-squared: 0.009548, Adjusted R-squared: 0.003789
F-statistic: 1.658 on 1 and 172 DF, p-value: 0.1996modelo_izquierda2 <- lm(military_gov ~ pre_military_gov, data = izquierda)
modelo_izquierda3 <- lm(military_gov ~ treat + pre_military_gov, data = izquierda)
modelo_izquierda4 <- lm(military_gov ~ treat + pre_military_gov + base_gender + age + v, data = izquierda)
stargazer(modelo_izquierda1, modelo_izquierda2, modelo_izquierda3, type = "text",
title = "Resultados de los Modelos para Individuos de Izquierda",
digits = 3)
Resultados de los Modelos para Individuos de Izquierda
=======================================================================================
Dependent variable:
-------------------------------------------------------------------
military_gov
(1) (2) (3)
---------------------------------------------------------------------------------------
treat -0.060 -0.088**
(0.046) (0.041)
pre_military_gov 0.453*** 0.464***
(0.061) (0.061)
Constant 0.132*** 0.047** 0.088***
(0.032) (0.022) (0.029)
---------------------------------------------------------------------------------------
Observations 174 171 171
R2 0.010 0.244 0.265
Adjusted R2 0.004 0.240 0.256
Residual Std. Error 0.305 (df = 172) 0.268 (df = 169) 0.265 (df = 168)
F Statistic 1.658 (df = 1; 172) 54.626*** (df = 1; 169) 30.254*** (df = 2; 168)
=======================================================================================
Note: *p<0.1; **p<0.05; ***p<0.01stargazer(modelo_izquierda4, type = "text",
title = "Resultados de los Modelos para Individuos de Izquierda",
digits = 3)
Resultados de los Modelos para Individuos de Izquierda
===============================================
Dependent variable:
---------------------------
military_gov
-----------------------------------------------
treat -0.097**
(0.041)
pre_military_gov 0.471***
(0.061)
base_gender -0.095**
(0.042)
age -0.009
(0.009)
v -0.012
(0.045)
Constant 0.445**
(0.197)
-----------------------------------------------
Observations 170
R2 0.293
Adjusted R2 0.271
Residual Std. Error 0.263 (df = 164)
F Statistic 13.563*** (df = 5; 164)
===============================================
Note: *p<0.1; **p<0.05; ***p<0.01Actividad opcional (10% de la nota del Reto extra)
La Hipótesis H1 que nos planteamos es que asistir al museo tiene un impacto positivo en la satisfacción con la democracia. A continuación, crearemos 4 modelos diferentes para comprobar la validez de nuestra hipótesis
Modelo 1: solo tratamiento
modelo_democracy1 <- lm(democracy ~ treat, data = all)
summary(modelo_democracy1)
Call:
lm(formula = democracy ~ treat, data = all)
Residuals:
Min 1Q Median 3Q Max
-1.3116 -0.3116 -0.1587 0.6884 1.8413
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.15873 0.05057 22.913 <2e-16 ***
treat 0.15286 0.06995 2.185 0.0297 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.5677 on 262 degrees of freedom
Multiple R-squared: 0.0179, Adjusted R-squared: 0.01415
F-statistic: 4.776 on 1 and 262 DF, p-value: 0.02974Modelo 2: Variable previa sin tratamiento
modelo_democracy2 <- lm(democracy ~ pre_democracy, data = all)
summary(modelo_democracy2)
Call:
lm(formula = democracy ~ pre_democracy, data = all)
Residuals:
Min 1Q Median 3Q Max
-1.7541 -0.1997 -0.1997 0.2459 1.3548
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.64524 0.06011 10.73 <2e-16 ***
pre_democracy 0.55442 0.04895 11.33 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.4656 on 258 degrees of freedom
(4 observations deleted due to missingness)
Multiple R-squared: 0.3321, Adjusted R-squared: 0.3295
F-statistic: 128.3 on 1 and 258 DF, p-value: < 2.2e-16Modelo 3: tratamiento y satisfacción previa con la democracia
modelo_democracy3 <- lm(democracy ~ treat + pre_democracy, data = all)
summary(modelo_democracy3)
Call:
lm(formula = democracy ~ treat + pre_democracy, data = all)
Residuals:
Min 1Q Median 3Q Max
-1.6816 -0.2660 -0.1281 0.2875 1.4253
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.57467 0.06638 8.657 5.41e-16 ***
treat 0.13786 0.05726 2.407 0.0168 *
pre_democracy 0.55348 0.04851 11.411 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.4613 on 257 degrees of freedom
(4 observations deleted due to missingness)
Multiple R-squared: 0.3468, Adjusted R-squared: 0.3417
F-statistic: 68.23 on 2 and 257 DF, p-value: < 2.2e-16Modelo 4: tratamiento y satisfacción previa con la democracia más controles
modelo_democracy4 <- lm(democracy ~ treat + pre_democracy + base_gender + age + v, data = all)
summary(modelo_democracy4)
Call:
lm(formula = democracy ~ treat + pre_democracy + base_gender +
age + v, data = all)
Residuals:
Min 1Q Median 3Q Max
-1.6797 -0.2575 -0.1352 0.2804 1.4047
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.643247 0.254562 2.527 0.0121 *
treat 0.126984 0.057806 2.197 0.0290 *
pre_democracy 0.534737 0.049664 10.767 <2e-16 ***
base_gender 0.017687 0.059754 0.296 0.7675
age -0.003258 0.010433 -0.312 0.7551
v -0.014888 0.067926 -0.219 0.8267
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.4593 on 250 degrees of freedom
(8 observations deleted due to missingness)
Multiple R-squared: 0.3323, Adjusted R-squared: 0.3189
F-statistic: 24.88 on 5 and 250 DF, p-value: < 2.2e-16Generamos la tabla con todos los modelos
stargazer(modelo_democracy1, modelo_democracy2, modelo_democracy3,
type = "text",
title = "Resultados de los Modelos para Satisfacción con la Democracia",
digits = 3)
Resultados de los Modelos para Satisfacción con la Democracia
==========================================================================================
Dependent variable:
----------------------------------------------------------------------
democracy
(1) (2) (3)
------------------------------------------------------------------------------------------
treat 0.153** 0.138**
(0.070) (0.057)
pre_democracy 0.554*** 0.553***
(0.049) (0.049)
Constant 1.159*** 0.645*** 0.575***
(0.051) (0.060) (0.066)
------------------------------------------------------------------------------------------
Observations 264 260 260
R2 0.018 0.332 0.347
Adjusted R2 0.014 0.329 0.342
Residual Std. Error 0.568 (df = 262) 0.466 (df = 258) 0.461 (df = 257)
F Statistic 4.776** (df = 1; 262) 128.272*** (df = 1; 258) 68.226*** (df = 2; 257)
==========================================================================================
Note: *p<0.1; **p<0.05; ***p<0.01Estudiando los resultados de los 4 modelos vemos que la hipótesis H1 se cumple pues el coeficiente de la variable treat es positivo en todos los modelos. Si bien es cierto que el impacto del tratamiento no es grande sí que es estadísticamente relevante. La satisfacción previa es la variable con mayor impacto en la satisfacción de la democracia.