Cantidad pivotal o estadístico para la estimación de la varianza poblacional \({\sigma}_{x}^{2}\)

\[ \text{Si }x_i\stackrel{iid}{\sim}N(mean,sd^2)\text{ entonces }{x}^{2}=\frac{({size}-1)\widehat{{sd}^{2}}}{{sd}^{2}}{\sim}{\chi}_{{size}-1}^{2} \]

Ejemplo

  1. Estandarización de una variable aleatoria con media igual a 176 y desviación estándar igual a 15, que puede ser la distribución de las estaturas de los individuos en una población cuyo promedio de estaturas sea igual 176 centímetros y en promedio se alejen de este valor en 3 centimetros

\[ P(\text{estaturas}=x)=\frac{1}{{3}\sqrt{2\pi}}e^{-\frac{1}{2}\left(\frac{x-{176}}{{3}}\right)^{2}}\text{ con }-0{\leq}x{\leq}\infty \]

estaturas <- rnorm(n = 10000, mean = 176, sd = 3)
cat("la media de las estaturas es: ", round(mean(estaturas),0)," y ","la desviación estándar de las estaturas es: ", round(sd(estaturas),0))
## la media de las estaturas es:  176  y  la desviación estándar de las estaturas es:  3
library(ggplot2)
qplot(estaturas, geom = "histogram", bins = 30, main="Histograma de las estaturas", xlab="Estaturas", fill=I("purple"))

\[ P\left(\frac{({size}-1)\widehat{{sd}^{2}}}{{sd}^{2}}=x\right)=\frac{\frac{1}{2}^{\frac{df}{2}}}{\Gamma\left(\frac{df}{2}\right)}x^{\frac{df}{2}-1}e^{-\frac{df}{2}}\text{ con }0{\leq}x{\leq}\infty\text{ y }df={size}-1>0 \]

  1. Simulación de escenarios con distinto número de repeticiones y tamaños de muestra para la obtención de la distribución de diferentes promedios muestrales obtenidos de ellas; con el fin de obtener la distribución límite que se espera sea normal, es decir, la distribución de la media muestral cuando se incrementan el tamaño de las muestras corresponde a una distribución normal y aquí es mostrado dicho resultado conocido como Teorema del límite central (o TLC por sus siglas).
n <- c(5, 11, 17, 23, 31)
t <- c(10, 100, 1000, 10000)

muestras.de.estaturas <- data.frame()

for(i in n) {
    col <- c()
    for(j in t) {
        trial <- 1:j
        counter <- j
        value <- c()
        while(counter > 0) {
            bucket <- sample(estaturas, i, replace = FALSE)
            chi <- (i-1)*var(bucket)/3**2
            value <- c(value, chi)
            counter <- counter - 1
        }
        col <- cbind(trial, value, i, j)
        muestras.de.estaturas <- rbind(muestras.de.estaturas, col)
    }
}

rm(col, bucket, value, counter, i, j, n, chi, t, trial)

str(muestras.de.estaturas)
## 'data.frame':    55550 obs. of  4 variables:
##  $ trial: num  1 2 3 4 5 6 7 8 9 10 ...
##  $ value: num  1.973 0.619 5.035 5.934 4.934 ...
##  $ i    : num  5 5 5 5 5 5 5 5 5 5 ...
##  $ j    : num  10 10 10 10 10 10 10 10 10 10 ...
names(muestras.de.estaturas) <- c("trial#", "value", "samples", "trials")

g <- ggplot(muestras.de.estaturas, aes(x = value)) + geom_density(fill = "purple") + 
        facet_grid(samples ~ trials, labeller = label_both) + 
        ggtitle("Distribución de la varianza poblacional simulada") + 
        geom_vline(xintercept = round(muestras.de.estaturas$samples-1,1), linetype = "dashed")
g

Ejemplo

  1. Estandarización de una variable aleatoria con media y desviación estándar iguales a 980.657, que puede ser la distribución de los ingresos de los individuos en una población cuyo promedio de estaturas sea igual $980.657 pesos y en promedio se alejen de este valor en $980.657 pesos.

\[ P(\text{ingresos}=x)=\frac{1}{980657}e^{-\frac{1}{980657}x}\text{ con }0{\leq}x{\leq}\infty \]

ingresos <- rexp(n = 10000, rate = 1/980657)
cat("la media de los ingresos es: ", round(mean(ingresos),0)," y ","la desviación estándar de los ingresos es: ", round(sd(ingresos),0))
## la media de los ingresos es:  995677  y  la desviación estándar de los ingresos es:  986178

\[ P\left(\frac{({size}-1)\widehat{{sd}^{2}}}{{sd}^{2}}=x\right)=chi-cuadrado\text{ con }0{\leq}x{\leq}\infty \]

library(ggplot2)
qplot(ingresos, geom = "histogram", bins = 30, main="Histograma de los ingresos", xlab="Ingresos", fill=I("brown"))

  1. Simulación de escenarios con distinto número de repeticiones y tamaños de muestra para la obtención de la distribución de diferentes promedios muestrales obtenidos de ellas; con el fin de obtener la distribución límite que se espera sea normal, es decir, la distribución de la media muestral cuando se incrementan el tamaño de las muestras corresponde a una distribución normal y aquí es mostrado dicho resultado conocido como Teorema del límite central (o TLC por sus siglas).
n <- c(5, 11, 17, 23, 31)
t <- c(10, 100, 1000, 10000)

muestras.de.ingresos <- data.frame()

for(i in n) {
    col <- c()
    for(j in t) {
        trial <- 1:j
        counter <- j
        value <- c()
        while(counter > 0) {
            bucket <- sample(ingresos, i, replace = FALSE)
            chi <- (i-1)*var(bucket)/980657**2
            value <- c(value, chi)
            counter <- counter - 1
        }
        col <- cbind(trial, value, i, j)
        muestras.de.ingresos <- rbind(muestras.de.ingresos, col)
    }
}

rm(col, bucket, value, counter, i, j, n, chi, t, trial)

str(muestras.de.ingresos)
## 'data.frame':    55550 obs. of  4 variables:
##  $ trial: num  1 2 3 4 5 6 7 8 9 10 ...
##  $ value: num  1.335 4.358 0.755 10.038 1.022 ...
##  $ i    : num  5 5 5 5 5 5 5 5 5 5 ...
##  $ j    : num  10 10 10 10 10 10 10 10 10 10 ...
names(muestras.de.ingresos) <- c("trial#", "value", "samples", "trials")

g <- ggplot(muestras.de.ingresos, aes(x = value)) + geom_density(fill = "brown") + 
        facet_grid(samples ~ trials, labeller = label_both) + 
        ggtitle("Distribución de la varianza poblacional simulada") + 
        geom_vline(xintercept = round(muestras.de.ingresos$samples-1,1), linetype = "dashed")
g

Ejemplo

  1. Estandarización de una variable aleatoria con media y desviación estándar iguales a 980.657, que puede ser la distribución de los ingresos de los individuos en una población cuyo promedio de estaturas sea igual $980.657 pesos y en promedio se alejen de este valor en $980.657 pesos.

\[ P(\text{ingresos}=x)=\frac{1}{980657}e^{-\frac{1}{980657}x}\text{ con }0{\leq}x{\leq}\infty \]

ingresos <- rexp(n = 10000, rate = 1/980657)
cat("la media de los ingresos es: ", round(mean(ingresos),0)," y ","la desviación estándar de los ingresos es: ", round(sd(ingresos),0))
## la media de los ingresos es:  965748  y  la desviación estándar de los ingresos es:  970217

\[ P\left(\frac{({size}-1)\widehat{{sd}^{2}}}{{sd}^{2}}=x\right)?=\frac{\frac{1}{2}^{\frac{df}{2}}}{\Gamma\left(\frac{df}{2}\right)}x^{\frac{df}{2}-1}e^{-\frac{df}{2}}\text{ con }0{\leq}x{\leq}\infty\text{ y }df={size}-1>0 \]

library(ggplot2)
qplot(ingresos, geom = "histogram", bins = 30, main="Histograma de los ingresos", xlab="Ingresos", fill=I("violet"))

  1. Simulación de escenarios con distinto número de repeticiones y tamaños de muestra para la obtención de la distribución de diferentes promedios muestrales obtenidos de ellas; con el fin de obtener la distribución límite que se espera sea normal, es decir, la distribución de la media muestral cuando se incrementan el tamaño de las muestras corresponde a una distribución normal y aquí es mostrado dicho resultado conocido como Teorema del límite central (o TLC por sus siglas).
n <- c(17, 23, 31, 41, 47)
t <- c(10, 100, 1000, 10000)

muestras.de.ingresos <- data.frame()

for(i in n) {
    col <- c()
    for(j in t) {
        trial <- 1:j
        counter <- j
        value <- c()
        while(counter > 0) {
            bucket <- sample(ingresos, i, replace = FALSE)
            chi <- (i-1)*var(bucket)/980657**2
            value <- c(value, chi)
            counter <- counter - 1
        }
        col <- cbind(trial, value, i, j)
        muestras.de.ingresos <- rbind(muestras.de.ingresos, col)
    }
}

rm(col, bucket, value, counter, i, j, n, chi, t, trial)

str(muestras.de.ingresos)
## 'data.frame':    55550 obs. of  4 variables:
##  $ trial: num  1 2 3 4 5 6 7 8 9 10 ...
##  $ value: num  14.32 6.97 42.84 6.47 26.57 ...
##  $ i    : num  17 17 17 17 17 17 17 17 17 17 ...
##  $ j    : num  10 10 10 10 10 10 10 10 10 10 ...
names(muestras.de.ingresos) <- c("trial#", "value", "samples", "trials")

g <- ggplot(muestras.de.ingresos, aes(x = value)) + geom_density(fill = "violet") + 
        facet_grid(samples ~ trials, labeller = label_both) + 
        ggtitle("Distribución de la varianza poblacional simulada") + 
        geom_vline(xintercept = round(muestras.de.ingresos$samples-1,1), linetype = "dashed")
g

Intervalo de confianza para la estimación de la varianza poblacional \({\sigma}_{x}^{2}\)

\[ P_{\chi_{size-1}^{2}}\left(L{\leq}\frac{({size}-1)\widehat{{sd}^{2}}}{{sd}^{2}}{\leq}U\right)=1-\alpha \]

\[ P_{\chi_{size-1}^{2}}\left(\frac{1}{L}{\geq}\frac{{sd}^{2}}{({size}-1)\widehat{{sd}^{2}}}{\geq}\frac{1}{U}\right)=1-\alpha \]

\[ P_{\chi_{size-1}^{2}}\left(\frac{1}{U}{\leq}\frac{{sd}^{2}}{({size}-1)\widehat{{sd}^{2}}}{\leq}\frac{1}{L}\right)=1-\alpha \]

\[ P_{\chi_{size-1}^{2}}\left(\frac{1}{U}{\cdot}({size}-1)\widehat{{sd}^{2}}{\leq}{sd}^{2}{\leq}\frac{1}{L}{\cdot}({size}-1)\widehat{{sd}^{2}}\right)=1-\alpha \]

\[ P_{\chi_{size-1}^{2}}\left(\frac{({size}-1)\widehat{{sd}^{2}}}{U}{\leq}{sd}^{2}{\leq}\frac{({size}-1)\widehat{{sd}^{2}}}{L}\right)=1-\alpha \]

\[ P\left({\chi}_{1-\frac{\alpha}{2}}^{2}{\leq}\frac{({size}-1)\widehat{{sd}^{2}}}{{sd}^{2}}{\leq}{\chi}_{\frac{\alpha}{2}}^{2}\right)=1-\alpha \]

\[ P\left(\frac{({size}-1)\widehat{{sd}^{2}}}{{\chi}_{\frac{\alpha}{2}}^{2}}{\leq}{sd}^{2}{\leq}\frac{({size}-1)\widehat{{sd}^{2}}}{{\chi}_{1-\frac{\alpha}{2}}^{2}}\right)=1-\alpha \]

Ejemplo intervalo de confianza para una varianza poblacional \({\sigma}_{x}^{2}\).

  1. Tras revisar a fondo los documentos oficiales, se obtuvo que la tasa de contagio del coronarivurs por país es de 2,68 que se obtuvo al analizar los 75 casos confirmados que se tenían al momento de la firma del decreto (martes en la tarde) , es decir, que tasa media de contagio fue de 2,68 con una desviación estándar de 0.5 contagios, basandose en la información de los datos para los 1.103 municipios del país, esto no quiere decir que la tasa media de contagio más pequeña es de 2,18 y la mayor resulta ser de 3,18, sino que de media de la tasa de contagio se encuentra entre 2 y 3 casos por cada persona con coronavirus. Para comprobar esto se se obtienen 150 contagios promedio por municipio en el país.
set.seed(555)
MuestraMunicipios <- round(rnorm(n = 150, mean = 2.68, sd = 0.5), 2) ; MuestraMunicipios
##   [1] 2.52 2.93 2.87 3.62 1.79 3.12 2.60 3.36 2.70 2.99 2.54 2.35 2.18 2.25 2.34
##  [16] 2.64 2.81 2.30 1.96 2.94 3.03 2.91 2.10 3.32 2.15 2.70 3.02 2.63 2.58 3.40
##  [31] 2.58 2.53 2.81 2.55 2.53 2.77 2.46 2.96 2.38 2.19 3.79 3.39 3.12 2.50 2.23
##  [46] 2.85 2.88 2.51 3.81 1.12 3.25 2.72 2.82 2.57 2.60 2.20 3.23 2.35 2.12 2.71
##  [61] 2.87 3.00 2.02 3.18 3.40 2.36 2.64 3.10 3.71 2.20 2.11 2.48 3.07 2.60 1.93
##  [76] 2.31 2.85 2.84 3.31 2.64 1.76 3.33 2.98 2.12 2.77 3.35 2.79 2.06 2.25 2.79
##  [91] 2.72 1.90 2.85 3.28 2.77 3.06 3.06 2.53 1.91 3.18 2.28 1.92 2.70 3.00 4.39
## [106] 2.29 2.62 2.72 2.95 2.74 2.81 2.40 3.05 1.81 2.04 2.76 3.27 3.00 2.75 1.84
## [121] 2.64 2.42 3.02 3.30 3.22 2.33 2.18 3.01 2.79 2.61 3.70 2.59 3.33 2.32 2.30
## [136] 1.73 1.99 2.85 2.61 3.21 2.17 1.52 2.23 2.64 2.35 2.36 3.86 3.17 2.24 2.22

El intervalo de confianza en este caso esta dado por:

\[ \left(\frac{({size}-1)\widehat{{sd}^{2}}}{{\chi}_{\frac{\alpha}{2}}^{2}};\frac{({size}-1)\widehat{{sd}^{2}}}{{\chi}_{1-\frac{\alpha}{2}}^{2}}\right) \]

  1. Calculo de la varianza muestral \(\widehat{{sd}^{2}}\)
VarianzaMunicipal_X <- round(var(MuestraMunicipios), 2) ; VarianzaMunicipal_X
## [1] 0.26
  1. Calculo del tamaño muestral \({size}\)
size <- length(MuestraMunicipios) ; size 
## [1] 150
  1. Calculo de los grados de libertad \({size}-1\)
df <- length(MuestraMunicipios)-1 ; df 
## [1] 149
  1. Calculo de los cuantíles de la distribución chi cuadrado \(\chi_{\frac{\alpha}{2}}^{2}\) y \(\chi_{1-\frac{\alpha}{2}}^{2}\)
nivel.conf <- 0.9; chi_alfa_0_5 <- qchisq(1 - (1 + nivel.conf)/2, df, TRUE); chi_alfa_0_5
## [1] 122.6049
nivel.conf <- 0.9; chi_alfa_9_5 <- qchisq((1 + nivel.conf)/2, df, TRUE); chi_alfa_9_5
## [1] 179.6825
  1. Calculo del límite inferior del intervalo de confianza \(\frac{({size}-1)\widehat{{sd}^{2}}}{{\chi}_{\frac{\alpha}{2}}^{2}}\)
Int.inf <- (df*VarianzaMunicipal_X)/(chi_alfa_9_5) ; Int.inf
## [1] 0.2156025
  1. Calculo del límite inferior del intervalo de confianza \(\frac{({size}-1)\widehat{{sd}^{2}}}{{\chi}_{1-\frac{\alpha}{2}}^{2}}\)
Int.sup <- (df*VarianzaMunicipal_X)/(chi_alfa_0_5) ; Int.sup
## [1] 0.3159742
  1. Calculo del intervalo de confianza \(\left(\frac{({size}-1)\widehat{{sd}^{2}}}{{\chi}_{\frac{\alpha}{2}}^{2}};\frac{({size}-1)\widehat{{sd}^{2}}}{{\chi}_{1-\frac{\alpha}{2}}^{2}}\right)\)
c(Int.inf, Int.sup)
## [1] 0.2156025 0.3159742
  1. Graficación del intervalo de confianza
library(mosaic)
(df*VarianzaMunicipal_X)/cdist( "chisq", .90, df=149, lower.tail=FALSE)

## [1] 0.2170486 0.3180962

  1. ¿Cuál sería el intervalo de confianza de la varianza, con un nivel de significación alfa del 1%?

  2. ¿Cuál sería el intervalo de confianza de la varianza, con un nivel de significación alfa del 2%?

  3. ¿Cuál sería el intervalo de confianza de la varianza, con un nivel de significación alfa del 4%?

  4. ¿Cuál sería el intervalo de confianza de la varianza, con un nivel de significación alfa del 6%?

  5. ¿Cuál sería el intervalo de confianza de la varianza, con un nivel de significación alfa del 11%?

  6. ¿Cuál sería el intervalo de confianza de la varianza, con un nivel de significación alfa del 12%?

  7. ¿Cuál sería el intervalo de confianza de la varianza, con un nivel de significación alfa del 16%?

  8. ¿Cuál sería el intervalo de confianza de la varianza, con un nivel de significación alfa del 17%?

  9. ¿Cuál sería el intervalo de confianza de la varianza, con un nivel de significación alfa del 20%?

  10. ¿Cuál sería el intervalo de confianza de la varianza, con un nivel de significación alfa del 25%?