Resumen del teorema del límite central

Cuando se toma una muestra suficientemente grande de una población, la distribución de la media de esas muestras se aproxima a una distribución normal, independientemente de la forma de la distribución original de la población, siempre y cuando las muestras sean tomadas de manera aleatoria e independiente. El TLC sugiere que, a medida que aumentamos el tamaño de las muestras que tomamos de una población y calculamos la media de esas muestras, la distribución de esas medias se acerca cada vez más a una distribución normal. Esto es útil en estadísticas porque permite hacer inferencias sobre poblaciones basadas en muestras y simplifica los cálculos en muchas aplicaciones.

Resumen del ejercicio

Pretendemos demostrar el teorema del límite central simulando una población de plantas donde el 50% están enfermas. A traves de varios ejercicios estadisticos demostraremos que a medida que aumentamos el numero de simulaciones la distribución de la población de plantas se acerca a una distribución normal.

#Se cargan las liberias necesarias

library(gridExtra)
library(ggplot2)
library(gganimate)
library(DT)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following object is masked from 'package:gridExtra':
## 
##     combine

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(knitr)

Creamos la población de plantas 50% enfermas

#Simulación de las plantas 

set.seed(123)  
poblacion <- sample(c(0, 1), size = 1000, replace = TRUE, prob = c(0.5, 0.5))

porcentaje_enfermas <- mean(poblacion) * 100
cat("Porcentaje de plantas enfermas en la población:", porcentaje_enfermas, "%\n")

## Porcentaje de plantas enfermas en la población: 50.7 %

df <- data.frame(Estado = c("Saludables", "Enfermas"),
                 Cantidad = c(sum(poblacion == 0), sum(poblacion == 1)))

# Calcular los porcentajes
total <- sum(df$Cantidad)
df$Porcentaje <- df$Cantidad / total * 100

# Crear el gráfico de barras
ggplot(df, aes(x = Estado, y = Cantidad, fill = Estado)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = paste(Cantidad, "(", Porcentaje, "%)")), vjust = -0.3, size = 4) +  # Agregar etiquetas de datos con porcentaje
  labs(title = "Distribución de Plantas Saludables y Enfermas",
       y = "Cantidad",
       fill = "Estado") +
  theme_minimal()

Estimamos la probabilidad de una población determinada. Como podemos observar se aleja del promedio poblacional en un 3.7%.

#Simulacion 2

simular_proporcion_muestral <- function(tamano_muestra) {
  
  muestra <- sample(poblacion, size = tamano_muestra)
  estimador_proporcion <- mean(muestra)
  
  return(estimador_proporcion)
}

tamano_muestra_ejemplo <- 100
estimador_ejemplo <- simular_proporcion_muestral(tamano_muestra_ejemplo)
cat("Estimador de la proporción muestral para un tamaño de muestra de", tamano_muestra_ejemplo, ":", estimador_ejemplo, "\n")

## Estimador de la proporción muestral para un tamaño de muestra de 100 : 0.47

Creamos simulaciones con N=5,10,15,20,30,50,60,100,200,500

#Simulacion 3

# Crear una función para realizar múltiples simulaciones y calcular estimadores de proporción muestral
simular_proporcion_muestral_multiples_tamanos <- function(tamanos_muestra, num_simulaciones) {
  resultados <- data.frame(Tamano_Muestra = integer(0), Estimador_Proporcion = numeric(0))
  
  for (tamano in tamanos_muestra) {
    for (i in 1:num_simulaciones) {
      muestra <- sample(poblacion, size = tamano)
      estimador_proporcion <- mean(muestra)
      resultados <- rbind(resultados, data.frame(Tamano_Muestra = tamano, Estimador_Proporcion = estimador_proporcion))
    }
  }
  
  return(resultados)
}

# Definir tamaños de muestra y número de simulaciones
tamanos_muestra <- c(5,10,15,20,30,50,60,100,200,500)
num_simulaciones <- 1000

# Realizar las simulaciones
resultados_simulaciones <- simular_proporcion_muestral_multiples_tamanos(tamanos_muestra, num_simulaciones)

Representaciones gráficas

Creamos gráficos donde podemos observar como a medida que auemntamos el N el promedio de la muestra se acerca al promedio poblacional.

# Crear el gráfico de líneas
library(ggplot2)

ggplot(resultados_simulaciones, aes(x = Tamano_Muestra, y = Estimador_Proporcion)) +
  geom_line() +
  labs(title = "Estimador de la Proporción Muestral vs. Tamaño de Muestra",
       x = "Tamaño de Muestra",
       y = "Estimador de la Proporción Muestral") +
  theme_minimal()

Creamos gráficos auxiliares donde corroboramos el teorema del limite central y vemos en los histogramas como los valores se acercan a la media poblacional.

# Crear un gráfico de caja para representar los resultados

ggplot(resultados_simulaciones, aes(x = factor(Tamano_Muestra), y = Estimador_Proporcion)) +
  geom_boxplot() +
  labs(title = "Distribución del Estimador de la Proporción Muestral por Tamaño de Muestra",
       x = "Tamaño de Muestra",
       y = "Estimador de la Proporción Muestral") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

# Crear una lista para almacenar los histogramas
histogramas <- list()

for (tamano in tamanos_muestra) {
  datos <- resultados_simulaciones$Estimador_Proporcion[resultados_simulaciones$Tamano_Muestra == tamano]
  histogramas[[as.character(tamano)]] <- ggplot(data.frame(Estimador_Proporcion = datos), aes(x = Estimador_Proporcion)) +
    geom_histogram(binwidth = 0.02, fill = "blue", color = "black", alpha = 0.7) +
    labs(title = paste("Histograma (Tamaño de Muestra =", tamano, ")"),
         x = "Estimador de la Proporción Muestral",
         y = "Frecuencia") +
    theme_minimal()
}


grid.arrange(grobs = histogramas, ncol = 2)

# Crear un conjunto de qq-plots para representar los resultados
par(mfrow = c(2, 3))  # Organizar en 2 filas y 3 columnas

for (tamano in tamanos_muestra) {
  datos <- resultados_simulaciones$Estimador_Proporcion[resultados_simulaciones$Tamano_Muestra == tamano]
  qqnorm(datos, main = paste("QQ-Plot (Tamaño de Muestra =", tamano, ")"))
  qqline(datos)
}

Repetimos el ejercicio para un numero diferente de simulaciones.

# Función para realizar simulaciones y obtener estadísticas básicas
simular_y_resumir <- function(tamanos_muestra, num_simulaciones) {
  resultados <- data.frame(Tamano_Muestra = integer(0), Estimador_Proporcion = numeric(0))
  
  for (tamano in tamanos_muestra) {
    for (i in 1:num_simulaciones) {
      muestra <- sample(poblacion, size = tamano)
      estimador_proporcion <- mean(muestra)
      resultados <- rbind(resultados, data.frame(Tamano_Muestra = tamano, Estimador_Proporcion = estimador_proporcion))
    }
  }
  
  # Calcular estadísticas básicas
  resumen <- resultados %>%
    group_by(Tamano_Muestra) %>%
    summarize(
      Media = mean(Estimador_Proporcion),
      Mediana = median(Estimador_Proporcion),
      Desviacion_Estandar = sd(Estimador_Proporcion),
      Minimo = min(Estimador_Proporcion),
      Maximo = max(Estimador_Proporcion)
    )
  
  return(list(Resultados = resultados, Resumen = resumen))
}

# Definir tamaños de muestra y número de simulaciones
tamanos_muestra <- c(5,10,15,20,30,50,60,100,200,500)
num_simulaciones <- 500

# Realizar simulaciones y obtener resumen
resultados <- simular_y_resumir(tamanos_muestra, num_simulaciones)



# Crear una tabla con estadísticas básicas
datatable(resultados$Resumen, options = list(pageLength = 5))

# Crear un dataframe con los resultados de las simulaciones
resultados_simulaciones$Tamano_Muestra <- as.factor(resultados_simulaciones$Tamano_Muestra)


# Crear una tabla con estadísticas básicas
tabla_estadisticas <- resultados_simulaciones %>%
  group_by(Tamano_Muestra) %>%
  summarize(Min = min(Estimador_Proporcion),
            Max = max(Estimador_Proporcion),
            Media = mean(Estimador_Proporcion),
            Mediana = median(Estimador_Proporcion),
            Desviacion_Estandar = sd(Estimador_Proporcion))

# Imprimir la tabla de estadísticas
kable(tabla_estadisticas, format = "html", caption = "Estadísticas de las Simulaciones")

Estadísticas de las Simulaciones
Tamano_Muestra	Min	Max	Media	Mediana	Desviacion_Estandar
5	0.0000000	1.0000000	0.5092000	0.6000000	0.2312766
10	0.1000000	1.0000000	0.5102000	0.5000000	0.1616852
15	0.1333333	0.8666667	0.5020000	0.4666667	0.1283885
20	0.2000000	0.9000000	0.5038000	0.5000000	0.1086387
30	0.2333333	0.8000000	0.5015333	0.5000000	0.0907334
50	0.3000000	0.7000000	0.5041800	0.5000000	0.0677607
60	0.3166667	0.6833333	0.5059167	0.5000000	0.0614016
100	0.3400000	0.6800000	0.5063200	0.5100000	0.0469026
200	0.4150000	0.6000000	0.5056750	0.5050000	0.0314382
500	0.4560000	0.5620000	0.5069060	0.5060000	0.0153483

Probabilidad 90%

Se repite el ejercicio para un número diferente de plantas enfermas.

# Ajusta la probabilidad al 90% de plantas enfermas
proporcion_enfermas <- 0.9
poblacion <- sample(c(0, 1), size = 1000, replace = TRUE, prob = c(1 - proporcion_enfermas, proporcion_enfermas))

# Realizar las mismas simulaciones nuevamente
tamanos_muestra <- c(5,10,15,20,30,50,60,100,200,500)
num_simulaciones <- 1000
resultados_simulaciones <- simular_proporcion_muestral_multiples_tamanos(tamanos_muestra, num_simulaciones)



# Crear un conjunto de histogramas para representar los resultados
library(ggplot2)
histogramas <- list()

for (tamano in tamanos_muestra) {
  datos <- resultados_simulaciones$Estimador_Proporcion[resultados_simulaciones$Tamano_Muestra == tamano]
  histogramas[[as.character(tamano)]] <- ggplot(data.frame(Estimador_Proporcion = datos), aes(x = Estimador_Proporcion)) +
    geom_histogram(binwidth = 0.02, fill = "blue", color = "black", alpha = 0.7) +
    labs(title = paste("Histograma (Tamaño de Muestra =", tamano, ")"),
         x = "Estimador de la Proporción Muestral",
         y = "Frecuencia") +
    theme_minimal()
}


grid.arrange(grobs = histogramas, ncol = 2)

# Calcular estadísticas básicas de los resultados
estadisticas_resultados <- summary(resultados_simulaciones$Estimador_Proporcion)

# Crear una tabla con las estadísticas
tabla_estadisticas <- data.frame(Estadistica = c("Mínimo", "1er Cuartil", "Mediana", "Media", "3er Cuartil", "Máximo"),
                                 Valor = c(estadisticas_resultados[1], quantile(resultados_simulaciones$Estimador_Proporcion, 0.25),
                                           median(resultados_simulaciones$Estimador_Proporcion), mean(resultados_simulaciones$Estimador_Proporcion),
                                           quantile(resultados_simulaciones$Estimador_Proporcion, 0.75), estadisticas_resultados[6]))

# Imprimir la tabla de estadísticas
print(tabla_estadisticas)

##   Estadistica     Valor
## 1      Mínimo 0.4000000
## 2 1er Cuartil 0.8950000
## 3     Mediana 0.9150000
## 4       Media 0.9122078
## 5 3er Cuartil 0.9500000
## 6      Máximo 1.0000000

Conclusiones.

A través de las simulaciones, hemos observado que el tamaño de la muestra tiene un impacto significativo en la precisión del estimador de la proporción muestral. A medida que aumenta el tamaño de la muestra, el estimador tiende a converger más cerca del valor verdadero de la proporción poblacional. Esto refuerza la importancia de recopilar tamaños de muestra adecuados para obtener estimaciones precisas.
Las simulaciones también nos han permitido explorar la distribución de los estimadores de la proporción muestral. Observamos que, en general, estos estimadores tienden a seguir distribuciones que se aproximan a una distribución normal a medida que aumenta el tamaño de la muestra, lo que respalda la validez de utilizar intervalos de confianza basados en la normalidad para estimar la proporción poblacional.
La simulación con diferentes proporciones de plantas enfermas (50% vs. 90%) destacó cómo la proporción real en la población puede afectar la precisión y la distribución del estimador. Cuando la proporción de plantas enfermas es más alta, la varianza del estimador puede disminuir y el estimador puede sesgarse hacia el valor verdadero. Esto subraya la importancia de conocer y considerar la proporción poblacional al planificar y realizar estimaciones.

Actividad 3

Cristian Ortega

2023-09-14