Problema 3
Christian David Vera Mendivelso
Paula
Vidal Godoy
Métodos y Simulación estadística
Maestría en Ciencia de Datos
Pontificia Universidad Javeriana de
Cali
Teorema del Límite Central
El Teorema del Límite Central es uno de los más importantes en la inferencia estadística y habla sobre la convergencia de los estimadores como la proporción muestral a la distribución normal. Algunos autores afirman que esta aproximación es bastante buena a partir del umbral n>30
Realice una simulación en la cual genere una población de n=1000 (Lote), donde el porcentaje de individuos (supongamos plantas) enfermas sea del 50%.
Genere una función que permita: Obtener una muestra aleatoria de la población y Calcule el estimador de la proporción muestral pˆ para un tamaño de muestra dado n
Repita el escenario anterior (b) n=500 veces y analice los resultados en cuanto al comportamiento de los 500 resultados del estimador pˆ . ¿Qué tan simétricos o sesgados son los resultados obtenidos? y ¿qué se puede observar en cuanto a la variabilidad?. Realice en su informe un comentario sobre los resultados obtenidos.
Repita los puntos b y c para tamaños de muestra n=5, 10, 15, 20, 30, 50, 60, 100, 200, 500
. Compare los resultados obtenidos para los diferentes tamaños de muestra en cuanto a la normalidad. Utilice pruebas de bondad y ajuste (shapiro wilks :
shspiro.test()) y métodos gráficos (gráfico de normalidad:qqnorm()). Comente en su informe los resultados obtenidosRepita toda la simulación (puntos a – d), pero ahora para lotes con 10% de plantas enfermas y de nuevo para lotes con un 90% de plantas enfermas. Concluya sobre los resultados del ejercicio
Solución.
1.Realice una simulación en la cual genere una población de n=1000 (Lote), donde el porcentaje de individuos (supongamos plantas) enfermas sea del 50%.
En primer lugar de crea una función que calcula la proporción muestral de una distribución binomial asignando una cantidad especifica de repeticiones, tamaño de muestra y una probabilidad de éxito del 50%
#función para calcular la proporción muestral con el número de repeticiones, n tamaño de muestra y p probabilidad de exito.
calcular_proporcion_muestral <- function(repeticiones, tam_muestra, prob_exito = 0.5) {
poblacion <- rbinom(n = repeticiones, size = tam_muestra, prob = prob_exito)
# Calcular la proporción muestral para cada repetición
proporcion_muestral <- poblacion / tam_muestra
return(proporcion_muestral)
}
proporciones<- calcular_proporcion_muestral(10000,1000)
mean(proporciones)2.Genere una función que permita: Obtener una muestra aleatoria de la población y calcule el estimador de la proporción muestral \(\hat{p}\) para un tamaño de muestra dado n:
Con la función generada en el apartado anterior se procederá a calcular la proporción muestral para una muestra de tamaño 5 con 50 repeticiones.
calcular_proporcion_muestral <- function(repeticiones, tam_muestra, prob_exito = 0.5) {
poblacion <- rbinom(n = repeticiones, size = tam_muestra, prob = prob_exito)
# Calcular la proporción muestral para cada repetición
proporcion_muestral <- poblacion / tam_muestra
return(proporcion_muestral)}
ej_2<- calcular_proporcion_muestral(50,5)
mean(ej_2)## [1] 0.4963.Repita el escenario anterior con n=500 veces y analice los resultados en cuanto al comportamiento de los 500 resultados del estimador \(\hat{p}\). ¿Qué tan simétricos o sesgados son los resultados obtenidos? y ¿qué se puede observar en cuanto a la variabilidad?. Realice en su informe un comentario sobre los resultados obtenidos.
Al aumentar la cantidad de repeticiones pero manteniendo constante el tamaño de muestra en 5 se observa que se genera simetría en la generación de los resultados, presentando mayor concentración en la probabilidad asignada en la distribución que en este caso es de 0.5, en el siguiente apartado se detallara más a detalle este comportamiento con distintos tamaños de muestra y mayor número de repeticiones.
library(ggplot2)
# Generar los datos
ej_3 <- calcular_proporcion_muestral(500, 5)
# Crear el histograma
ggplot(data.frame(proporcion_muestral = ej_3), aes(x = proporcion_muestral)) +
geom_histogram(binwidth = 0.05, color = "black", fill = "lightblue") +
labs( x = "Proporción Muestral", y = "Frecuencia") +
theme_minimal()
Fig.1 Histograma de proporción muestral con 500 repeticiones.
4.Repita los puntos b y c para tamaños de muestra n=5, 10, 15, 20, 30, 50, 60, 100, 200, 500
La Figura 2 y la Tabla 2 presentan histogramas para distintos tamaños de muestra con 1,000 repeticiones. En la Tabla 2 se observa que, a medida que aumenta el tamaño de la muestra, la media se acerca más al valor asignado a p . Esto indica que el estimador se vuelve insesgado al aproximarse a la proporción de éxito real de la población.
La curtosis mide la forma de la distribución de una variable aleatoria, evaluando su “altitud” y “ancho”. Se observa que este valor tiende a 3, lo que indica que la distribución se aproxima a la forma de una distribución normal. Por otro lado, a medida que crece el tamaño de la muestra, la asimetría se acerca más a cero, lo que sugiere que la distribución se vuelve más simétrica respecto a la media.
#Este chunk no se evalua debido a que tarda varios minutos en ejecutarse al crear el gif, en lugar de esto el gif creado se guarda y se llama en el documento.
library(ggplot2)
library(gganimate)
library(transformr)
# Función para calcular las proporciones muestrales
calcular_proporcion_muestral <- function(repeticiones, tam_muestra, prob_exito = 0.5) {
poblacion <- rbinom(n = repeticiones, size = tam_muestra, prob = prob_exito)
proporcion_muestral <- poblacion / tam_muestra
return(proporcion_muestral)
}
# Función para crear un dataframe con las proporciones muestrales para diferentes tamaños de muestra
crear_dataframe <- function(tam_muestras, repeticiones) {
resultados <- data.frame()
for (tam_muestra in tam_muestras) {
proporcion_muestral <- calcular_proporcion_muestral(repeticiones, tam_muestra)
resultados <- rbind(resultados, data.frame(
Proporcion = proporcion_muestral,
TamanoMuestra = tam_muestra
))
}
return(resultados)
}
# Definir los tamaños de muestra y repeticiones
tam_muestras <- c(5,10,15,20,30,50,60,100,200,500)
repeticiones <- 1000
# Crear el dataframe con los resultados
df <- crear_dataframe(tam_muestras, repeticiones)
# Crear la animación
animacion <- ggplot(df, aes(x = Proporcion)) +
geom_histogram(aes(y = ..count..), binwidth = function(x) 0.1 * 1/sqrt(mean(df$TamanoMuestra)), fill = "blue", color = "black", alpha = 0.7) +
labs(title = 'Tamaño de Muestra: {closest_state}', x = 'Proporción Muestral', y = 'Frecuencia') +
transition_states(TamanoMuestra, transition_length = 2, state_length = 2) +
ease_aes('linear') +
scale_x_continuous(limits = function(x) {
tam_actual <- unique(df$TamanoMuestra)[1]
rango <- range(df$Proporcion[df$TamanoMuestra == tam_actual])
c(rango[1] - 0.05, rango[2] + 0.05) # Añadir margen para mejor visualización
}) +
theme(
plot.title = element_text(hjust = 0.5, size = 16) # Centrar el título y ajustar tamaño
)
# Guardar la animación como archivo GIF
anim_save("Animacion.gif", animation = animate(animacion, nframes = length(tam_muestras) * 60, fps = 60 ,height = 600, width = 800))
library(e1071) # Para la función kurtosis y skewness
library(dplyr)
library(kableExtra)
# Función para calcular las proporciones muestrales
calcular_proporcion_muestral <- function(repeticiones, tam_muestra, prob_exito = 0.5) {
poblacion <- rbinom(n = repeticiones, size = tam_muestra, prob = prob_exito)
proporcion_muestral <- poblacion / tam_muestra
return(proporcion_muestral)
}
# Función para crear un dataframe con las proporciones muestrales para diferentes tamaños de muestra
crear_dataframe <- function(tam_muestras, repeticiones) {
resultados <- data.frame()
for (tam_muestra in tam_muestras) {
proporcion_muestral <- calcular_proporcion_muestral(repeticiones, tam_muestra)
resultados <- rbind(resultados, data.frame(
Proporcion = proporcion_muestral,
TamanoMuestra = tam_muestra
))
}
return(resultados)}
# Definir los tamaños de muestra y repeticiones
tam_muestras <- c(5,10,15,20,30, 50,60, 100, 200, 500)
repeticiones <- 1000
# Crear el dataframe con los resultados
df <- crear_dataframe(tam_muestras, repeticiones)
# Calcular media, varianza, curtosis y asimetría
calcular_estadisticas <- function(df) {
estadisticas <- df %>%
group_by(TamanoMuestra) %>%
summarise(
Media = mean(Proporcion),
Varianza = var(Proporcion),
Curtosis = kurtosis(Proporcion) - 3, # Curtosis ajustada a exceso de curtosis
Asimetria = skewness(Proporcion)
)
return(estadisticas)}
# Calcular las estadísticas para el dataframe df
estadisticas_df <- calcular_estadisticas(df)
# Mostrar la tabla con kable
estadisticas_df %>%
rename("Tamaño Muestra" = TamanoMuestra) %>%
kable(digits = 8, format = "pipe", align = "c") %>%
kable_styling(latex_options = "hold_position", position = "center", full_width = FALSE) %>%
column_spec(1:ncol(estadisticas_df), width = "8em") # Ajusta el ancho total| Tamaño Muestra | Media | Varianza | Curtosis | Asimetria |
|---|---|---|---|---|
| 5 | 0.4894000 | 0.05450214 | -3.436627 | 0.04296056 |
| 10 | 0.4927000 | 0.02690361 | -3.322802 | -0.06934596 |
| 15 | 0.4955333 | 0.01729512 | -3.131937 | 0.03516485 |
| 20 | 0.4998500 | 0.01280028 | -3.276493 | -0.03253734 |
| 30 | 0.5071000 | 0.00794976 | -3.074078 | 0.07607930 |
| 50 | 0.5036000 | 0.00495039 | -2.923035 | 0.02911989 |
| 60 | 0.5013167 | 0.00425558 | -2.953525 | 0.02276826 |
| 100 | 0.5012200 | 0.00256147 | -3.208126 | -0.02406251 |
| 200 | 0.5008400 | 0.00132707 | -2.937261 | 0.17811007 |
| 500 | 0.4990900 | 0.00048279 | -3.067267 | -0.14109114 |
5.Compare los resultados obtenidos para los
diferentes tamaños de muestra en cuanto a la normalidad. Utilice pruebas
de bondad y ajuste (shapiro wilks :shspiro.test()) y
métodos gráficos (gráfico de normalidad: qqnorm()). Comente
en su informe los resultados obtenidos.
QQ Plot
Para evaluar la normalidad de la distribución, se utilizará en primer lugar el método gráfico Q-Q (cuantiles-cuantiles). Este método compara los cuantiles de la distribución muestral con los cuantiles de una distribución normal para observar gráficamente cómo se ajustan. En la Figura 3 se puede ver que, a medida que aumenta el tamaño de la muestra, la varianza disminuye, y los cuantiles se acercan más a la media (en este caso, 0.5), manteniendo una simetría respecto a la media.
#Se crea un gif con el QQ plot,este chunk no se evalua cuando se exporta a html pues tarda varios minutos en cargar, en lugar de esto solo se guarda y se llama directamente como un gif al documento para evitar tiempos largos.
library(ggplot2)
library(gganimate)
library(transformr)
# Función para calcular los cuartiles teóricos y empíricos
calcular_qq_data <- function(repeticiones, tam_muestra, prob_exito = 0.5) {
proporcion_muestral <- calcular_proporcion_muestral(repeticiones, tam_muestra)
qq_data <- data.frame(
CuantilTeorico = qnorm(ppoints(repeticiones), mean = 0.5, sd = sqrt(0.5 * (1 - 0.5) / tam_muestra)),
CuantilEmpirico = sort(proporcion_muestral)
)
return(qq_data)}
# Función para crear un dataframe con los datos del QQ plot para diferentes tamaños de muestra
crear_dataframe_qq <- function(tam_muestras, repeticiones) {
resultados <- data.frame()
for (tam_muestra in tam_muestras) {
qq_data <- calcular_qq_data(repeticiones, tam_muestra)
resultados <- rbind(resultados, data.frame(
CuantilTeorico = qq_data$CuantilTeorico,
CuantilEmpirico = qq_data$CuantilEmpirico,
TamanoMuestra = tam_muestra
))
}
return(resultados)}
# Definir los tamaños de muestra y repeticiones
tam_muestras <- c(5,10,15,20,30, 50,60, 100, 200, 500)
repeticiones <- 1000
# Crear el dataframe con los resultados del QQ plot
df_qq <- crear_dataframe_qq(tam_muestras, repeticiones)
# Crear la animación del QQ plot
animacion_qq <- ggplot(df_qq, aes(x = CuantilTeorico, y = CuantilEmpirico)) +
geom_point(color = "green", alpha = 0.6) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(title = 'Tamaño de Muestra: {closest_state}', x = 'Cuantil Teórico', y = 'Cuantil Empírico') +
transition_states(TamanoMuestra, transition_length = 2, state_length = 2) +
ease_aes('linear') +
theme(
plot.title = element_text(hjust = 0.5, size = 16) # Propiedades del título.
)
# Generar la animación
anim <- animate(animacion_qq, nframes = length(tam_muestras) * 60, fps = 60, height = 600, width = 800)
# Guardar la animación como archivo GIF
anim_save("Animacion_qq.gif", animation = anim)
Test de Shapiro-Wilk.
El test de Shapiro-Wilk es una prueba estadística que se usa para determinar si una muestra proviene de una distribución normal, a continuación de presenta los resultados de la prueba usando la función shapiro.test y α del 5% para distintos tamaños de muestra.
- Hipótesis Nula (\(H_0\)): La muestra sigue una distribución normal.
- Hipótesis Alternativa (\(H_A\)): La muestra no sigue una distribución normal.
library(ggplot2)
library(kableExtra)
# Función para realizar el Shapiro-Wilk test y recolectar los resultados
realizar_shapiro_test <- function(tam_muestras, repeticiones) {
resultados <- data.frame(TamanoMuestra = numeric(0), PValor = numeric(0))
for (tam_muestra in tam_muestras) {
proporcion_muestral <- calcular_proporcion_muestral(repeticiones, tam_muestra)
shapiro_test <- shapiro.test(proporcion_muestral)
resultados <- rbind(resultados, data.frame(
TamanoMuestra = tam_muestra,
PValor = shapiro_test$p.value
))
}
return(resultados)
}
# Definir los tamaños de muestra y repeticiones
tam_muestras <- c(5,10,15,20,30, 50,60, 100, 200, 500)
repeticiones <- 1000
# Realizar el Shapiro-Wilk test para cada tamaño de muestra
resultados_shapiro <- realizar_shapiro_test(tam_muestras, repeticiones)
# Formatear los p-valores a 8 decimales
resultados_shapiro$PValor <- format(resultados_shapiro$PValor, digits = 8, nsmall = 8, scientific = FALSE)
# Definir los nombres de las columnas deseados
nombres_columnas <- c("Tamaño de Muestra", "P-Valor")
# Mostrar los resultados en una tabla con kableExtra
resultados_shapiro %>%
setNames(nombres_columnas) %>%
kable(digits = 8, format = "pipe", align = "c") %>%
kable_styling(latex_options = "hold_position", position = "center", full_width = FALSE) %>%
column_spec(1:ncol(resultados_shapiro), width = "8em")| Tamaño de Muestra | P-Valor |
|---|---|
| 5 | 0.0000000000000000000020799608 |
| 10 | 0.0000000000000022566465434694 |
| 15 | 0.0000000000115163515653445235 |
| 20 | 0.0000000010559048402446956338 |
| 30 | 0.0000004826859667874607702671 |
| 50 | 0.0000232059671139985500536856 |
| 60 | 0.0000945645284695224944658543 |
| 100 | 0.0099503913204414765752980898 |
| 200 | 0.0360955405430665177135551858 |
| 500 | 0.0359256870204116493527912723 |
Se observa que a medida que el tamaño de la muestra aumenta, los p-value tienden a aumentar, lo cual sugiere que en tamaños de muestra pequeños las proporciones muestrales no se ajustan a la normalidad, pero a medida que se toman valores mayores cada vez se aproxima a una distribución normal, esto es un buen reflejo del Teorema del Limite Central que dice que a medida que se aumenta la cantidad de muestras, la distribución de las medias o proporciones muéstrales tienen a ser normales.En este caso se observa que el p-valor del tamaño de muestra 500 es mayor a 0.05 por lo cual no se rechaza la hipótesis nula, sugiriendo que la distribución es aproximadamente normal.
6.Repita toda la simulación (puntos a – d), pero ahora para lotes con 10% de plantas enfermas y de nuevo para lotes con un 90% de plantas enfermas. Concluya sobre los resultados del ejercicio.
La Figura 4 muestra el histograma de las proporciones muestrales ajustando la probabilidad de que una planta esté enferma al 90% mientras se mantienen constantes los demás parámetros. El gráfico se desplaza hacia la derecha, mostrando un sesgo hacia la izquierda que disminuye a medida que aumenta el tamaño muestral. En cuanto a la varianza, se observa que es menor comparada con el escenario en el que la probabilidad era del 50%, debido a que la probabilidad de fracaso es considerablemente más baja en este caso.
# Este chunk crea de nuevo la animación con la probabilidad del 90% de que una planta esté enferma.La animacion resultante se guardará en y se llamará para evitar tiempos de espera al exportar el documento.
library(ggplot2)
library(gganimate)
library(transformr)
# Función para calcular las proporciones muestrales
calcular_proporcion_muestral <- function(repeticiones, tam_muestra, prob_exito = 0.9) {
poblacion <- rbinom(n = repeticiones, size = tam_muestra, prob = prob_exito)
proporcion_muestral <- poblacion / tam_muestra
return(proporcion_muestral)
}
# Crear un dataframe con las proporciones muestrales para diferentes tamaños de muestra
crear_dataframe <- function(tam_muestras, repeticiones) {
resultados <- data.frame()
for (tam_muestra in tam_muestras) {
proporcion_muestral <- calcular_proporcion_muestral(repeticiones, tam_muestra)
resultados <- rbind(resultados, data.frame(
Proporcion = proporcion_muestral,
TamanoMuestra = tam_muestra
))
}
return(resultados)}
# Definir los tamaños de muestra y repeticiones
tam_muestras <- c(5,10,15,20,30,50,60,100,200,500)
repeticiones <- 1000
# Crear el dataframe con los resultados
df <- crear_dataframe(tam_muestras, repeticiones)
# Crear la animación con transición más lenta y sin ser continua
animacion <- ggplot(df, aes(x = Proporcion)) +
geom_histogram(aes(y = ..count..), binwidth = function(x) 0.1 * 1/sqrt(mean(df$TamanoMuestra)), fill = "blue", color = "black", alpha = 0.7) +
labs(title = 'Tamaño de Muestra: {closest_state}', x = 'Proporción Muestral', y = 'Frecuencia') +
transition_states(TamanoMuestra, transition_length = 2, state_length = 2) +
ease_aes('linear') +
scale_x_continuous(limits = function(x) {
tam_actual <- unique(df$TamanoMuestra)[1]
rango <- range(df$Proporcion[df$TamanoMuestra == tam_actual])
c(rango[1] - 0.05, rango[2] + 0.05) # Añadir margen para mejor visualización
}) +
theme(
plot.title = element_text(hjust = 0.5, size = 16) # Propiedades del titulo
)
# Mostrar la animación
animate(animacion, nframes = length(tam_muestras) * 60, fps = 60 ,height = 600, width = 800)
library(e1071) # Para la función kurtosis y skewness
library(dplyr)
library(kableExtra)
# Función para calcular las proporciones muestrales
calcular_proporcion_muestral <- function(repeticiones, tam_muestra, prob_exito = 0.9) {
poblacion <- rbinom(n = repeticiones, size = tam_muestra, prob = prob_exito)
proporcion_muestral <- poblacion / tam_muestra
return(proporcion_muestral)
}
# Función para crear un dataframe con las proporciones muestrales para diferentes tamaños de muestra
crear_dataframe <- function(tam_muestras, repeticiones) {
resultados <- data.frame()
for (tam_muestra in tam_muestras) {
proporcion_muestral <- calcular_proporcion_muestral(repeticiones, tam_muestra)
resultados <- rbind(resultados, data.frame(
Proporcion = proporcion_muestral,
TamanoMuestra = tam_muestra
))
}
return(resultados)
}
# Definir los tamaños de muestra y repeticiones
tam_muestras <- c(5,10,15,20,30, 50,60, 100, 200, 500)
repeticiones <- 1000
# Crear el dataframe con los resultados
df <- crear_dataframe(tam_muestras, repeticiones)
# Calcular media, curtosis, asimetría y varianza
calcular_estadisticas <- function(df) {
estadisticas <- df %>%
group_by(TamanoMuestra) %>%
summarise(
Media = mean(Proporcion),
Varianza = var(Proporcion),
Curtosis = kurtosis(Proporcion) - 3, # Curtosis ajustada a exceso de curtosis
Asimetria = skewness(Proporcion)
)
# Reordenar columnas según el orden deseado
estadisticas <- estadisticas %>%
select(TamanoMuestra, Media, Varianza, Curtosis, Asimetria)
return(estadisticas)
}
# Calcular las estadísticas para el dataframe df
estadisticas_df <- calcular_estadisticas(df)
# Mostrar la tabla con kable
estadisticas_df %>%
kable(digits = 8, format = "pipe", align = "c") %>%
kable_styling(latex_options = "hold_position", position = "center", full_width = FALSE) %>%
column_spec(1:ncol(estadisticas_df), width = "8em") | TamanoMuestra | Media | Varianza | Curtosis | Asimetria |
|---|---|---|---|---|
| 5 | 0.8962000 | 0.01784340 | -2.267905 | -1.0986891 |
| 10 | 0.8985000 | 0.01059835 | -2.274587 | -0.9929153 |
| 15 | 0.8960000 | 0.00644378 | -2.778051 | -0.6478966 |
| 20 | 0.8974000 | 0.00447271 | -2.805601 | -0.5470246 |
| 30 | 0.9018000 | 0.00299754 | -2.681415 | -0.5494727 |
| 50 | 0.9010400 | 0.00185357 | -2.952856 | -0.3871890 |
| 60 | 0.9002833 | 0.00162849 | -2.042907 | -0.6521846 |
| 100 | 0.8983000 | 0.00087919 | -2.949890 | -0.1808936 |
| 200 | 0.9005200 | 0.00047901 | -3.027928 | -0.1894508 |
| 500 | 0.8998560 | 0.00018880 | -2.983630 | -0.1914753 |
#Se exporta el gif del qqplot generado y se llama directamente en el documento.
library(ggplot2)
library(gganimate)
library(transformr)
# Función para calcular los cuartiles teóricos y empíricos
calcular_qq_data <- function(repeticiones, tam_muestra, prob_exito = 0.9) {
proporcion_muestral <- calcular_proporcion_muestral(repeticiones, tam_muestra, prob_exito = prob_exito)
qq_data <- data.frame(
CuantilTeorico = qnorm(ppoints(repeticiones), mean = prob_exito, sd = sqrt(prob_exito * (1 - prob_exito) / tam_muestra)),
CuantilEmpirico = sort(proporcion_muestral)
)
return(qq_data)
}
# Función para crear un dataframe con los datos del QQ plot para diferentes tamaños de muestra
crear_dataframe_qq <- function(tam_muestras, repeticiones, prob_exito = 0.9) {
resultados <- data.frame()
for (tam_muestra in tam_muestras) {
qq_data <- calcular_qq_data(repeticiones, tam_muestra, prob_exito)
resultados <- rbind(resultados, data.frame(
CuantilTeorico = qq_data$CuantilTeorico,
CuantilEmpirico = qq_data$CuantilEmpirico,
TamanoMuestra = tam_muestra
))
}
return(resultados)
}
# Definir los tamaños de muestra y repeticiones
tam_muestras <- c(5, 10, 15, 20, 30, 50, 60, 100, 200, 500)
repeticiones <- 1000
# Crear el dataframe con los resultados del QQ plot
df_qq2 <- crear_dataframe_qq(tam_muestras, repeticiones, prob_exito = 0.9)
# Crear la animación del QQ plot
animacion_qq <- ggplot(df_qq2, aes(x = CuantilTeorico, y = CuantilEmpirico)) +
geom_point(color = "green", alpha = 0.6) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(title = 'Tamaño de Muestra: {closest_state}', x = 'Cuantil Teórico', y = 'Cuantil Empírico') +
transition_states(TamanoMuestra, transition_length = 2, state_length = 2) +
ease_aes('linear') +
theme(
plot.title = element_text(hjust = 0.5, size = 16) # Centrar el título y ajustar tamaño
)
# Mostrar la animación
animate(animacion_qq, nframes = length(tam_muestras) * 60, fps = 60, height = 600, width = 800)
#Test de Shapiro-Wilk
library(ggplot2)
library(kableExtra)
calcular_proporcion_muestral <- function(repeticiones, tam_muestra, prob_exito = 0.9) {
poblacion <- rbinom(n = repeticiones, size = tam_muestra, prob = prob_exito)
proporcion_muestral <- poblacion / tam_muestra
return(proporcion_muestral)
}
# Función para realizar el Shapiro-Wilk test y recolectar los resultados
realizar_shapiro_test <- function(tam_muestras, repeticiones) {
resultados <- data.frame(TamanoMuestra = numeric(0), PValor = numeric(0))
for (tam_muestra in tam_muestras) {
proporcion_muestral <- calcular_proporcion_muestral(repeticiones, tam_muestra)
shapiro_test <- shapiro.test(proporcion_muestral)
resultados <- rbind(resultados, data.frame(
TamanoMuestra = tam_muestra,
PValor = shapiro_test$p.value
))
}
return(resultados)
}
# Definir los tamaños de muestra y repeticiones
tam_muestras <- c(5,10,15,20,30, 50,60, 100, 200, 500)
repeticiones <- 1000
# Realizar el Shapiro-Wilk test para cada tamaño de muestra
resultados_shapiro <- realizar_shapiro_test(tam_muestras, repeticiones)
# Formatear los p-valores a 8 decimales
resultados_shapiro$PValor <- format(resultados_shapiro$PValor, digits = 6, nsmall = 6, scientific = FALSE)
# Definir los nombres de las columnas deseados
nombres_columnas <- c("Tamaño de Muestra", "P-Valor")
# Mostrar los resultados en una tabla con kableExtra
resultados_shapiro %>%
setNames(nombres_columnas) %>%
kable(digits = 6, format = "pipe", align = "c") %>%
kable_styling(latex_options = "hold_position", position = "center", full_width = FALSE) %>%
column_spec(1:ncol(resultados_shapiro), width = "8em")| Tamaño de Muestra | P-Valor |
|---|---|
| 5 | 0.00000000000000000000000000000000000000816544 |
| 10 | 0.00000000000000000000000000000178901413847286 |
| 15 | 0.00000000000000000000000004501086943831827153 |
| 20 | 0.00000000000000000000097909709752649988169157 |
| 30 | 0.00000000000000001240935606676746707794506408 |
| 50 | 0.00000000000147892357785352670284176324067005 |
| 60 | 0.00000000000543978459770803549934437004509391 |
| 100 | 0.00000001362659212307478804031973806942801275 |
| 200 | 0.00001940189653984772491859822629578502528602 |
| 500 | 0.00183382682675039534667127405498376901960000 |
A diferencia del caso de 50% de probabilidad de éxito, en la figura 5 se observa que las proporciones muestrales se encuentran mayormente concentradas en 0.9,, mostrando que la distribución es menos dispersa y mas sesgada hacia la derecha, en ambos casos entre mayor sea la cantidad del tamaño de la muestra, las proporciones muéstrales tieden a ser mas similares a una distribución normal, aunque en menor medida en comparación al caso de probabilidad de 0.5 para la distribución binomial, esto pues se evidencia un sesgo a la derecha al incrementar la probabilidad de éxito a 0.9.