estudiando diferencias!

NIDIA CAYHUALLA

A continuación se ha añadido algunos comentarios en algunos puntos. cargando datos:

filename="dataMundo.csv"
data=read.csv(filename,stringsAsFactors =F)

verificando tipos:

str(data)
## 'data.frame':    175 obs. of  12 variables:
##  $ Country       : chr  "Afghanistan" "Albania" "Andorra" "Angola" ...
##  $ gasto2000     : num  NA 3.3 NA 2.6 4.6 2.8 4.9 5.6 3.9 2.9 ...
##  $ gasto2005     : num  NA 3.2 1.6 2.8 3.9 2.7 4.9 5.2 3 NA ...
##  $ gasto2010     : num  3.5 NA 3.1 3.5 5 3.2 5.6 5.7 2.8 NA ...
##  $ drop2000      : num  NA NA NA NA 5.5 1.5 NA NA 3.1 18.6 ...
##  $ drop2005      : num  NA 10.4 NA NA 9.2 NA NA NA 4 NA ...
##  $ drop2010      : num  NA 2.1 NA NA 6.9 4 NA 0.6 2.8 NA ...
##  $ drop2015      : num  NA 11.2 NA NA NA 5.3 NA 0.4 1.1 NA ...
##  $ incomeIneq2017: num  NA 29 NA 42.7 42.4 32.5 34.7 30.5 16.6 NA ...
##  $ pisaRead2015  : int  NA 405 NA NA 425 NA 503 485 NA NA ...
##  $ pisaMath2015  : int  NA 413 NA NA 456 NA 494 497 NA NA ...
##  $ pisaSci2015   : int  NA 427 NA NA 475 NA 510 495 NA NA ...

Habrá bajado el abandono PROMEDIO?

  • exploracion gráfica:
varsRepeated=c('drop2000','drop2005','drop2010','drop2015')
drops1=data[complete.cases(data[,varsRepeated]),] #data sin perdidos
boxplot(drops1[,varsRepeated])

  • Evaluando 2 MOMENTOS: prueba T La deserción escolar de los años 2000, 2005, 2010 y 2015 son mostradas en la imagen anterior. Se observa que la mediana está señalada con una línea negra e indica que la deserción escolar no pasa del 5%. Se ha de considerar que en el drop del 2010 y 2015 hay dos paises pasa de 60, es decir salen de la norma.
# prueba a dos colas: solo pregunta si las medias de los años difieren.
# si p-value es menor que 0.05 se acepta que HAY DIFERENCIAS
t.test(drops1$drop2000, drops1$drop2005, paired = TRUE, alternative = "two.sided")
## 
##  Paired t-test
## 
## data:  drops1$drop2000 and drops1$drop2005
## t = -1.086, df = 27, p-value = 0.2871
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -3.580692  1.102120
## sample estimates:
## mean of the differences 
##               -1.239286

en este punto se analiza no hay diferencia entre el año 2000 y el 2005. En promedio se afirma que hay diferencia ya que el P VALOR es menor de 0.5

# prueba a la cola izquierda: pregunta si la media del primer año es menor a la del año posterior.
# si p-value es menor que 0.05 se acepta que es MENOR
t.test(drops1$drop2000, drops1$drop2005, 
       paired = TRUE, alternative = "less")
## 
##  Paired t-test
## 
## data:  drops1$drop2000 and drops1$drop2005
## t = -1.086, df = 27, p-value = 0.1435
## alternative hypothesis: true difference in means is less than 0
## 95 percent confidence interval:
##       -Inf 0.7043883
## sample estimates:
## mean of the differences 
##               -1.239286

DATA NO está balanceada para hacer calculo para todos los años.

OTRA DATA:

  1. apelar a ciudadania
  2. decir que esta siendo vigilado
  3. decir que le dirá a los vecinos si va a votar o no …y a algunos no se les envió nada.
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.000
## turnout promedio segun mensaje para el 2006: 
tapply(social$primary2006, social$messages, mean)
## Civic Duty    Control  Hawthorne  Neighbors 
##  0.3145377  0.2966383  0.3223746  0.3779482

Se muestra el porcentaje de los asistentes según el incentivo o castigo de cada grupo, considerese que Control es el grupo contros, es decir que no recibió incentivo o castigo.

## turnout del  control group 
(ctTO=tapply(social$primary2006, social$messages, mean)[2])
##   Control 
## 0.2966383

Qué tanto se diferencian del grupo de control?

## control group turnout - mean de cada grupo
tapply(social$primary2006, social$messages, mean) -ctTO
## Civic Duty    Control  Hawthorne  Neighbors 
## 0.01789934 0.00000000 0.02573631 0.08130991

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: Según este análisis la variable “verguenza social” tiene más influencia.

tapply(social$yearofbirth, social$messages, mean)
## Civic Duty    Control  Hawthorne  Neighbors 
##   1956.341   1956.186   1956.295   1956.147
tapply(social$primary2004, social$messages, mean)
## Civic Duty    Control  Hawthorne  Neighbors 
##  0.3994453  0.4003388  0.4032300  0.4066647
tapply(social$hhsize, social$messages, mean)
## Civic Duty    Control  Hawthorne  Neighbors 
##   2.189126   2.183667   2.180138   2.187770

Efecto del experimento:

library(ggpubr)
## Loading required package: ggplot2
## Loading required package: magrittr
ggerrorplot(social, x = "messages", y = "primary2006", 
            desc_stat = "mean_se")

La data está completa, pero NO balanceada.

Cuando no tenemos “experimento”:

minwage <- read.csv("minwage.csv")

Veamos sueldos de dos Estados en USA:

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.00

Queremos saber el efecto del aumento de ingresos en el empleo. Este se dió en un Estado (NJ) pero no en otro (PA).

# se respeto ley en NJ?
minwageBefore=5.05
minwageNJ <- subset(minwage, subset = (location != "PA"))
mean(minwageNJ$wageBefore < minwageBefore) # NJ before
## [1] 0.9106529
mean(minwageNJ$wageAfter < minwageBefore) # NJ after
## [1] 0.003436426

En PA no hay ley, pero veamos cómo se comporta antes y después de que en NJ se dio ley: empresas en las que el sueldo mínimo no se había cambiado. El análisis dice que solo un 0.3% que aún no ha implementado la ley. Entonces se está implemntando la ley.

minwagePA <- subset(minwage, subset = (location == "PA"))
mean(minwagePA$wageBefore < minwageBefore) # PA before 
## [1] 0.9402985
mean(minwagePA$wageAfter < minwageBefore) # PA after 
## [1] 0.9552239

Si 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
minwageNJ$fullPropAfter <- minwageNJ$fullAfter /
(minwageNJ$fullAfter + minwageNJ$partAfter)

## proporcion de trabajadores a fulltime en PA
minwagePA$fullPropAfter <- minwagePA$fullAfter /
(minwagePA$fullAfter + minwagePA$partAfter) 

## diferencias: si sale negativa conforma teoría!!!!
mean(minwageNJ$fullPropAfter) - mean(minwagePA$fullPropAfter)
## [1] 0.04811886

Este 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 probando causalidad sin que controle el entorno.

Por lo que lo anterior es valido, solo si no hubiera algo mas que haya provocado la diferencia:

Para verificar, la diferencia a pesar de:

## proporcion full-time en NJ "antes":
minwageNJ$fullPropBefore <- minwageNJ$fullBefore /
(minwageNJ$fullBefore + minwageNJ$partBefore) 

## Diference entre antes y despues del incremento para NJ:
NJdiff <- mean(minwageNJ$fullPropAfter) - mean(minwageNJ$fullPropBefore)

# diferencia DESPUES-ANTES en CASO observado
NJdiff
## [1] 0.02387474
## proporcion full-time en PA "antes":
minwagePA$fullPropBefore <- minwagePA$fullBefore/(minwagePA$fullBefore + minwagePA$partBefore) 

## Diference entre antes y despues del incremento para PA:
PAdiff <- mean(minwagePA$fullPropAfter) -mean(minwagePA$fullPropBefore) 

# diferencia DESPUES-ANTES en CASO de comparación
PAdiff
## [1] -0.03768357

Si 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.06155831

Esto 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.