- AQUI SE PLANTEA EXPERIMENTO:
Mandar diversos tipos de mensaje para incentivar la participacion en elecciones.
- apelar a ciudadania (“Civic Duty”).
- decir que esta siendo vigilado (“Hawthorne”).
- decir que le dirá a los vecinos si va a votar o no (“Neighbors”). …y a algunos no se les envió nada (grupo de “control”).
** ¿ Tendra alguno de estos mensajes efecto en ir a votar?**
# sex: sexo
# yearofbirth: año de nacimiento
# primary2004 / 2006: indica si votó o no en esas elecciones
# hhsize: indica numero de gente en el hogar
# messages: mensajes al que fue expuesto
social <- read.csv("social.csv",stringsAsFactors = T)
summary(social) # ## sex yearofbirth primary2004 messages
## female:152702 Min. :1900 Min. :0.0000 Civic Duty: 38218
## male :153164 1st Qu.:1947 1st Qu.:0.0000 Control :191243
## Median :1956 Median :0.0000 Hawthorne : 38204
## Mean :1956 Mean :0.4014 Neighbors : 38201
## 3rd Qu.:1965 3rd Qu.:1.0000
## Max. :1986 Max. :1.0000
## primary2006 hhsize
## Min. :0.0000 Min. :1.000
## 1st Qu.:0.0000 1st Qu.:2.000
## Median :0.0000 Median :2.000
## Mean :0.3122 Mean :2.184
## 3rd Qu.:1.0000 3rd Qu.:2.000
## Max. :1.0000 Max. :8.000Analicemos la votacion del 2006:
# conteo
table(social$primary2006)##
## 0 1
## 210361 95505# proporcion
barplot(prop.table(table(social$primary2006)),ylim = c(0,1))
Veamos el porcentaje de votacion por grupo de mensaje:
# funcion tapply, numerica, categorica
tapply(social$primary2006, social$messages, mean)## Civic Duty Control Hawthorne Neighbors
## 0.3145377 0.2966383 0.3223746 0.3779482Graficando:
library(ggpubr)## Loading required package: ggplot2## Loading required package: magrittrggerrorplot(social, x = "messages",
y = "yearofbirth",
desc_stat = "mean_se",
)
ggerrorplot(social, x = "messages",
y = "hhsize",
desc_stat = "mean_se",
)
kruskal.test(primary2004 ~ messages,
data=social)$p.value<=0.05 ## [1] FALSE## turnout del control group
(CONTROLval=tapply(social$primary2006, social$messages, mean)[2])## Control
## 0.2966383Qué tanto se diferencian del grupo de control?
## control group turnout - mean de cada grupo
tapply(social$primary2006, social$messages, mean) -CONTROLval## Civic Duty Control Hawthorne Neighbors
## 0.01789934 0.00000000 0.02573631 0.08130991- VERIFICANDO PROCESO ADECUADO:
La variable de interés es reacción a los mensajes, pero el efecto de estos no debería ser tal en las otras variables:
tapply(social$yearofbirth, social$messages, mean)## Civic Duty Control Hawthorne Neighbors
## 1956.341 1956.186 1956.295 1956.147tapply(social$primary2004, social$messages, mean)## Civic Duty Control Hawthorne Neighbors
## 0.3994453 0.4003388 0.4032300 0.4066647tapply(social$hhsize, social$messages, mean)## Civic Duty Control Hawthorne Neighbors
## 2.189126 2.183667 2.180138 2.187770Cuando no tenemos “experimento”:
minwage <- read.csv("minwage.csv")Veamos esta informacion de algunos negocios que funcionan en dos estados de las EEUUAA:
# chain: negocio estudiado
# location: ubicacion del negocio
# wageBefore/After: pago por hora antes/despues
# fullBefore/After: trabajadores contratados a TC antes/despues
# partBefore/After: trabajadores contratados a TP antes/despues
summary(minwage)## chain location wageBefore wageAfter
## burgerking:149 centralNJ: 45 Min. :4.250 Min. :4.250
## kfc : 75 northNJ :146 1st Qu.:4.250 1st Qu.:5.050
## roys : 88 PA : 67 Median :4.500 Median :5.050
## wendys : 46 shoreNJ : 33 Mean :4.618 Mean :4.994
## southNJ : 67 3rd Qu.:4.987 3rd Qu.:5.050
## Max. :5.750 Max. :6.250
## fullBefore fullAfter partBefore partAfter
## Min. : 0.000 Min. : 0.000 Min. : 0.00 Min. : 0.00
## 1st Qu.: 2.125 1st Qu.: 2.000 1st Qu.:11.00 1st Qu.:11.00
## Median : 6.000 Median : 6.000 Median :16.25 Median :17.00
## Mean : 8.475 Mean : 8.362 Mean :18.75 Mean :18.69
## 3rd Qu.:12.000 3rd Qu.:12.000 3rd Qu.:25.00 3rd Qu.:25.00
## Max. :60.000 Max. :40.000 Max. :60.00 Max. :60.00Queremos saber el efecto del aumento de ingresos en el empleo. Este aumento se dió en un Estado (NJ) pero no en otro (PA).
El pago por hora en NJ:
pagoHoraNuevo=5.05Los negocios en NJ:
chainNJ <- subset(minwage, subset = (location != "PA"))Los negocios en PA:
chainPA <- subset(minwage, subset = (location == "PA"))¿Se respeto ley en NJ?
#
mean(chainNJ$wageBefore < pagoHoraNuevo) # NJ negocios que pagaban menos que nuevo monto## [1] 0.9106529mean(chainNJ$wageAfter < pagoHoraNuevo) # NJ negocios que pagan nuevo monto## [1] 0.003436426En PA no hay ley, pero veamos como se comporta antes y despues de que en NJ se dio ley:
mean(chainPA$wageBefore < pagoHoraNuevo) # PA before ## [1] 0.9402985mean(chainPA$wageAfter < pagoHoraNuevo) # PA after ## [1] 0.9552239Si la teoría dice que el aumento de sueldo genera desempleo, la diferencia de proporciones de empleo debe LUEGO ser menor (negativa) si se compara NJ con PA (donde no hubo aumento):
## proporcion de trabajadores a fulltime en NJ LUEGO DE AUMENTO
chainNJ$fullPropAfter <- chainNJ$fullAfter /
(chainNJ$fullAfter + chainNJ$partAfter)
## proporcion de trabajadores a fulltime en PA LUEGO DE AUMENTO en NJ
chainPA$fullPropAfter <- chainPA$fullAfter /
(chainPA$fullAfter + chainPA$partAfter) Diferencias: si sale negativa conforma teoría!!!!
# LUEGO DE AUMENTO
mean(chainNJ$fullPropAfter) - mean(chainPA$fullPropAfter)## [1] 0.04811886Este resultado dice que el empleo aumentó en NJ luego de subir los ingresos (o al menos no bajo).
Claro, ese aumento puedo haber sido provocado por otra razon: recuerden que estoy tratando de probar causalidad sin que controle el entorno.
Por lo que lo anterior es valido, solo si no hubiera algo mas que haya provocado la diferencia:
Veamos la diferencias despues-antes en NJ:
## proporcion full-time en NJ "ANTES":
chainNJ$fullPropBefore <- chainNJ$fullBefore /
(chainNJ$fullBefore + chainNJ$partBefore)
## Diference entre antes y despues del incremento para NJ:
NJdiff <- mean(chainNJ$fullPropAfter) - mean(chainNJ$fullPropBefore)
# diferencia DESPUES-ANTES en CASO observado
NJdiff## [1] 0.02387474Veamos la diferencias despues-antes en PA:
## proporcion full-time en PA "antes":
chainPA$fullPropBefore <- chainPA$fullBefore/(chainPA$fullBefore + chainPA$partBefore)
## Diference entre antes y despues del incremento para PA:
PAdiff <- mean(chainPA$fullPropAfter) -mean(chainPA$fullPropBefore)
# diferencia DESPUES-ANTES en CASO de comparación
PAdiff## [1] -0.03768357Si es negativa, podemos afirmar que la teoría de la baja de empleo antes aumento de sueldo se debe mantener en este caso.
## difference-in-differences
NJdiff - PAdiff## [1] 0.06155831Esto es evaluación de impacto, donde hay grupo intervenido y de comparación. Recuerda: 1. No puedes hacer esta tecnica si NO convences que los grupos antes de la intervención son similares. 2. No puedes hacer esta tecnica si NO convences que lo que pase en un grupo no tiene que afectar al otro. 3. El grupo de comparación te sirve como contrafactual, pues éste no es observable.