Sesión 13
Problemas de Intervalos de Confianza
Problema 1
Enunciado del problema
El fin de semana del 30 de junio del 2020 un grupo de ciudadanos inconformes salió a las calles a protestar en contra de las medidas del actual gobierno. La marcha fue realizada en caravanas de automóviles en diversas ciudades de la república, acción que parece ser que no fue del agrado de las redes sociales.
La maestría en Periodismo del CIDE organiza una encuesta para saber cual es la opinión de los ciudadanos sobre la marcha a una muestra aleatoria de la población mexicana, con reemplazo, a 1,000 habitantes de la república, registrando 1 si la opinión fue favorable y 0 si fue desfavorable.
Calcule la proporción de la población mexicana que está a favor de la marcha y su respectivo intervalo de confianza al 95%.
## # A tibble: 6 x 1
## respuestas
## <dbl>
## 1 1
## 2 0
## 3 0
## 4 0
## 5 0
## 6 1# Obtenemos la media
media <-
mean(datos$respuestas)
# Calculamos el Error Estandar
ee <- sd(datos$respuestas)/sqrt(1000)
# Limite superior e inferior
lim_sup <- media + ee*qnorm(p = 0.975, mean = 0, sd = 1)
lim_inf <- media - ee*qnorm(p = 0.975, mean = 0, sd = 1)Conclusiones:
Mi estimacion del porcentaje de personas en Mexico que esta a favor de la marcha en automovil es de el 34% +- 1.5% con un límite superior de 36.9% y un límite inferior del 31% con un nivel de confianza del 95%.
Ahora, supongamos que algún político del partido oficial hace una encuesta en twitter y resulta que el porcentaje de la población que apoya a la marcha en automovil es del 1%. En base a los resultados obtenidos arriba… ¿qué conclusión podría obtener de este estudio de Twitter?
R: Que hay algo raro en la metodología que siguió el segundo estudio que hace que se encuentre sesgado, dado que el resultado se encuentra bastante lejos del límite inferior del intervalo de confianza.
Problema 2.
Enunciado del problema
En la Universidad Autónoma del Estado de Morelos se quiere conocer el porcentaje de participación de los jóvenes de 18 años en las elecciones intermedias locales.
Un investigador piensa que los jóvenes de esa edad no les interesa votar por sus diputados locales o federales, mientras que otro investigador tiene la hipótesis de que, a esa edad, estan tan emocionados de tener credencial que votan en gran proporción y en grandes cantidades.
De las mil secciones electorales que hay en el estado, se consiguió una muestra aleatoria de 200 secciones, obteniendo información de la Lista Nominal (LN, total de jóvenes de 18 años en la sección) y la cantidad de estos que sí votó (SV).
Obtenga el porcentaje de participación promedio y el intervalo de confianza de dicha estimación al 99%. ¿Qué podemos concluir de todos los jóvenes morelenses de 18 años a partir de esta muestra?
library(tidyverse)
# Datos ----
datos <- readr::read_csv("Bases de datos/datosSeccionElectoralMorelos.csv")
# Pista: La participación se calcula como el cociente
# (la división) de los que si votaron entre el total
# de los que hay (LN)
# Generamos la variable de participación
datos <- datos %>%
mutate(part = SV/LN)
# Exploramos
head(datos)## # A tibble: 6 x 6
## EDAD SECCION LN SV NV part
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 18 4 161 140 21 0.870
## 2 18 5 497 497 0 1
## 3 18 8 152 53 99 0.349
## 4 18 17 106 47 59 0.443
## 5 18 23 109 66 43 0.606
## 6 18 30 51 18 33 0.353## [1] 0.5483367# Obtenemos los intervalos de confianza:
# 1. Calculamos el error estándar:
n <- nrow(datos)
ee <- sd(datos$part)/sqrt(n)
# Obtenemos los limites superior e inferior
# del intervalo de confianza:
lim_sup <- media + qnorm(p = 0.995,
mean = 0,
sd = 1)*ee
lim_inf <- media - qnorm(p = 0.005,
mean = 0,
sd = 1,
lower.tail = FALSE)*eeConclusión de la estimación
La media de participación de los jóvenes morelenses de 18 años es del 54.8% +- 1.358% dentro de un intervalo de confianza al 99% que va desde el 51.33 al 54.8% al 99% de confianza.
Ahora, no podemos concluir si los votantes votan mas a los 18 sin analizar otro grupo de edad, por lo que se requiere hacer este análisis a mas grupos y comparar las medias para ver si hay alguna diferencia real.
Problema 3.
Enunciado del problema
El gobierno, preocupado por la calificación y el mal desempeño obtenido tras las ultimas pruebas estandarizadas a jóvenes de preparatoria deciden llevar a cabo una política pública entre jóvenes de tercer año de bachillerato. Para evitar que estos tengan que trabajar, y garantizar que tienen el material necesario para estudiar, se les proporciona a un grupo aleatorio de jóvenes una transferencia monetaria para que cubran sus gastos diarios, de $20,000 pesos semestrales, mientras que a otro grupo de ellos, no se les da nada (grupo de control)
Se evalúa a estos dos grupos a partir de un examen estandarizado (igual para todos) para ver si el apoyo económico tiene un rendimiento sobre su desempeño académico, obteniendo las calificaciones de cada uno.
Obtenga la calificación promedio por cada grupo y su respectivo intervalo de confianza al 95% (tiene que obtener dos intervalos de confianza). Discuta, a partir de este resultado, si hay alguna diferencia entre ambos grupos.
Código elaborado por Ami Sosa y Luis Ernesto Mendoza Ovando
# Datos ----
# Librerias
library(dplyr)
library(ggplot2)
#Base de datos
calificaciones <- readr::read_csv("Bases de datos/calificacionesExamenTransferencia.csv")
# Agrupamos por categoría del experimento
Transferencias <- calificaciones %>%
filter(condicion=="Transferencia")
Control <- calificaciones %>%
filter(condicion=="Control")
# Sacamos la media por categoría
media.Transfer <- mean(Transferencias$calificaciones)
media.Control <- mean(Control$calificaciones)
# Numero de observaciones
n<- 35
# Obtenemos el error estándar de ambos grupos
err.est.Transfer <- sd(Transferencias$calificaciones)/sqrt(n)
err.est.Transfer ## [1] 0.3000976## [1] 0.3186458#Obtenemos los límites de los I.C.
# Limites Transferencia
# límite superior:
media.Transfer + err.est.Transfer*qnorm(0.025, lower.tail = F)## [1] 8.305323## [1] 7.128962## [1] 7.250249## [1] 6.00118# Visualizamos los Intervalos de Confianza:
plotear <- tibble(
media.Transfer = media.Transfer,
media.Control = media.Control,
)
ggplot() +
### Media transferencia
geom_vline(xintercept = media.Transfer, color = "red") +
# Lim superior IC transferencia
geom_vline(xintercept = media.Transfer + err.est.Transfer*qnorm(0.025, lower.tail = F),
color = "orange") +
# Lim inferior IC transferencia
geom_vline(xintercept = media.Transfer - err.est.Transfer*qnorm(0.025, lower.tail = F),
color = "orange") +
### Media control
geom_vline(xintercept = media.Control, color = "blue") +
# Lim superior IC control
geom_vline(xintercept = media.Control + err.est.Control*qnorm(0.025, lower.tail = F),
color = "purple") +
# Lim inferior IC control
geom_vline(xintercept = media.Control - err.est.Control*qnorm(0.025, lower.tail = F),
color = "purple") +
theme_classic()
Linea en azul, media del grupo de control. Linea en rojo, media del grupo de transferencia. Lineas en morado: lim. superior e inferior del IC de la media del grupo de control. Lineas en naranja: lim. superior e inferior del IC de la media del grupo de transferencia.
El límite superior del grupo de control (7.250249) se traslapa con el límite inferior del grupo de tratamiento (7.128962), como se ve en la gráfica de arriba.
La región de traslape incluye todos los casos en los cuales, por pura probabilidad, pudieron haber ocurrido para ambos grupos. Para afirmar que hay un efecto, los intervalos de confianza de ambos grupos no deberían traslaparse.
Eso nos lleva a concluir que la evidencia que tenemos no apoya que la diferencia en las medias se deba a la política pública, con intervalos de confianza del 95%. Quizá valdría la pena invertir en algún otro tipo de política, con un mayor efecto sobre el rendimiento de los chavos.