Objetivo: Simular el teorema del límite central.

Descripción: Con un conjunto de datos y librerías adecuadas, simular el valor de la media muestral comparado con el valor de la media poblacional asociando con ello con el teorema del límite central.

Paso 1. Cargar librerias

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(mosaic)
## Warning: package 'mosaic' was built under R version 4.0.3
## Registered S3 method overwritten by 'mosaic':
##   method                           from   
##   fortify.SpatialPolygonsDataFrame ggplot2
## 
## The 'mosaic' package masks several functions from core packages in order to add 
## additional features.  The original behavior of these functions should not be affected by this.
## 
## Attaching package: 'mosaic'
## The following object is masked from 'package:Matrix':
## 
##     mean
## The following object is masked from 'package:ggplot2':
## 
##     stat
## The following objects are masked from 'package:dplyr':
## 
##     count, do, tally
## The following objects are masked from 'package:stats':
## 
##     binom.test, cor, cor.test, cov, fivenum, IQR, median, prop.test,
##     quantile, sd, t.test, var
## The following objects are masked from 'package:base':
## 
##     max, mean, min, prod, range, sample, sum
library(readr)
library(ggplot2)  
library(knitr)    
library(fdth)     
## 
## Attaching package: 'fdth'
## The following objects are masked from 'package:mosaic':
## 
##     sd, var
## The following objects are masked from 'package:stats':
## 
##     sd, var
library(gtools)   
## 
## Attaching package: 'gtools'
## The following object is masked from 'package:mosaic':
## 
##     logit
library(Rmpfr)
## Warning: package 'Rmpfr' was built under R version 4.0.3
## Loading required package: gmp
## Warning: package 'gmp' was built under R version 4.0.3
## 
## Attaching package: 'gmp'
## The following object is masked from 'package:mosaic':
## 
##     factorize
## The following objects are masked from 'package:Matrix':
## 
##     crossprod, tcrossprod
## The following objects are masked from 'package:base':
## 
##     %*%, apply, crossprod, matrix, tcrossprod
## C code of R package 'Rmpfr': GMP using 64 bits per limb
## 
## Attaching package: 'Rmpfr'
## The following object is masked from 'package:gmp':
## 
##     outer
## The following objects are masked from 'package:stats':
## 
##     dbinom, dgamma, dnbinom, dnorm, dpois, pnorm
## The following objects are masked from 'package:base':
## 
##     cbind, pmax, pmin, rbind

Paso 2. Cargar datos

FUENTE: http://www.itchihuahua.edu.mx/academic/industrial/estadistica1/cap01b.html

N <- 1000000; 

edad.poblacion <- round(rnorm(N, mean = 35, sd = 5), 0)

summary(edad.poblacion)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       9      32      35      35      38      61
paste("El valor de edad de una pobacion. Los primeros cincuenta valores ...")
## [1] "El valor de edad de una pobacion. Los primeros cincuenta valores ..."
head(edad.poblacion, 50) 
##  [1] 32 39 37 33 30 41 27 34 40 32 36 38 36 38 33 43 39 30 37 29 31 42 34 39 34
## [26] 31 40 33 43 29 30 32 33 36 38 28 41 31 33 38 36 31 51 19 41 35 39 32 35 28
paste("El valor de edad de una pobacion. Los últimos cincuenta valores ...")
## [1] "El valor de edad de una pobacion. Los últimos cincuenta valores ..."
tail(edad.poblacion, 50)
##  [1] 33 32 33 38 28 36 33 31 45 35 34 31 33 34 29 32 37 41 37 47 31 43 32 36 33
## [26] 38 39 37 37 33 38 41 30 43 30 21 29 42 36 26 38 33 37 37 40 31 34 28 29 30
media.pob <- mean(edad.poblacion)
desv.std <- sd(edad.poblacion)

paste("Los parámetros de la media y desviación estándard de la población")
## [1] "Los parámetros de la media y desviación estándard de la población"
media.pob; desv.std
## [1] 35.00315
## [1] 5.005949

1-) Determinar medias y desviaciones muestrales.

n <- 500
muestras <- data.frame(m1=sample(edad.poblacion, n),
                       m2=sample(edad.poblacion, n),
                       m3=sample(edad.poblacion, n),
                       m4=sample(edad.poblacion, n),
                       m5=sample(edad.poblacion, n))

summary(muestras)
##        m1              m2              m3              m4       
##  Min.   :20.00   Min.   :19.00   Min.   :19.00   Min.   :19.00  
##  1st Qu.:32.00   1st Qu.:31.00   1st Qu.:31.00   1st Qu.:32.00  
##  Median :35.00   Median :35.00   Median :35.00   Median :35.00  
##  Mean   :34.71   Mean   :34.40   Mean   :34.94   Mean   :35.29  
##  3rd Qu.:38.00   3rd Qu.:37.25   3rd Qu.:38.00   3rd Qu.:38.00  
##  Max.   :49.00   Max.   :51.00   Max.   :49.00   Max.   :50.00  
##        m5       
##  Min.   :19.00  
##  1st Qu.:31.00  
##  Median :35.00  
##  Mean   :35.01  
##  3rd Qu.:39.00  
##  Max.   :49.00
kable(head(muestras, 10), caption = "Muestras de la población. Los primeros diez de 500 registros")
Muestras de la población. Los primeros diez de 500 registros
m1 m2 m3 m4 m5
38 40 38 35 37
33 35 37 44 44
41 34 31 30 28
33 31 38 35 33
33 26 33 34 40
39 34 41 40 46
34 39 40 39 29
44 36 45 33 40
36 28 38 43 29
36 35 38 41 41
kable(head(muestras, 10), caption = "Muestras de la población. Los últimos diez de 500 registros")
Muestras de la población. Los últimos diez de 500 registros
m1 m2 m3 m4 m5
38 40 38 35 37
33 35 37 44 44
41 34 31 30 28
33 31 38 35 33
33 26 33 34 40
39 34 41 40 46
34 39 40 39 29
44 36 45 33 40
36 28 38 43 29
36 35 38 41 41
medias <- 0
error <- 0

for(i in 1:5) {
  medias[i] <- mean(muestras[,i])
  error[i] <- medias[i] - media.pob
}

error.muestreo <- data.frame(Media.Poblacion = media.pob, Media.Muestras = medias, Errores = error)

kable(error.muestreo, caption = "Error de media de edad de cada muestra con respecto a la media de la población")
Error de media de edad de cada muestra con respecto a la media de la población
Media.Poblacion Media.Muestras Errores
35.00315 34.706 -0.297151
35.00315 34.400 -0.603151
35.00315 34.944 -0.059151
35.00315 35.292 0.288849
35.00315 35.012 0.008849
hist(edad.poblacion, main = "Histrograma de la edad de la población")

hist(muestras$m1, main = "Histrograma de la edad de la muestra 1", ylab = "Edades", xlab="Observacaiones")

hist(muestras$m2, main = "Histrograma de la edad de la muestRa 2", ylab = "Edades", xlab="Observacaiones")

hist(muestras$m3, main = "Histrograma de la edad de la muestRa 3", ylab = "Edades", xlab="Observacaiones")

hist(muestras$m4, main = "Histrograma de la edad de la muestRa 4", ylab = "Edades", xlab="Observacaiones")

hist(muestras$m5, main = "Histrograma de la edad de la muestRa 5", ylab = "Edades", xlab="Observacaiones")

options(scipen = 999) # Para mostrar notación normal y no científica en el valor de N: 1e+06
N; n;
## [1] 1000000
## [1] 500
options(scipen = 0) # Regresa a notación numérica normal 
summary(edad.poblacion)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       9      32      35      35      38      61
media.pob; desv.std
## [1] 35.00315
## [1] 5.005949

Para ejemplificar el teorema de límite central se reduce la población a 10 con muestras de 2 personas.

Simulando una nueva población con los mismos valores de media de edad igual a 35 y desviación de 5.

Se determinan los nuevos parámetros de medias y desviaciones estándar de la población. * N = 10, tamaño de la población * n = 2, tamaño de la muestra

N <- 10; n <- 2

edad.poblacion <- round(rnorm(N, mean = 35, sd = 5), 0)

edad.poblacion
##  [1] 32 35 31 37 29 35 31 30 41 31
media.pob <- mean(edad.poblacion)
desv.std <- sd(edad.poblacion)

media.pob; desv.std
## [1] 33.2
## [1] 3.735714
n.combinaciones <- factorialMpfr(N) / (factorialMpfr(n) * (factorialMpfr(N-n)))
as.integer(n.combinaciones)
## [1] 45
muestras <- cbind(1:as.integer(n.combinaciones))

muestras <- cbind(muestras, combinations(N, n, 1:N))

muestras <- cbind(muestras, edad.poblacion[muestras[,2]], edad.poblacion[muestras[,3]])

medias <- 0
error <- 0

for(i in 1:as.integer(n.combinaciones)) {
  medias[i] <- mean(muestras[i,c(4,5)])
  error[i] <- medias[i] - media.pob
}

muestras <- cbind(muestras, medias)
muestras <- cbind(muestras, media.pob)
muestras <- cbind(muestras, error)

muestras <- data.frame(muestras)

colnames(muestras) <- c("Muestra", "Pos.1", "Pos.2", "Valor.1", "Valor.2", "Media muestra", "Media pob.", "Error")

kable(muestras, caption = "Las muestras")
Las muestras
Muestra Pos.1 Pos.2 Valor.1 Valor.2 Media muestra Media pob. Error
1 1 2 32 35 33.5 33.2 0.3
2 1 3 32 31 31.5 33.2 -1.7
3 1 4 32 37 34.5 33.2 1.3
4 1 5 32 29 30.5 33.2 -2.7
5 1 6 32 35 33.5 33.2 0.3
6 1 7 32 31 31.5 33.2 -1.7
7 1 8 32 30 31.0 33.2 -2.2
8 1 9 32 41 36.5 33.2 3.3
9 1 10 32 31 31.5 33.2 -1.7
10 2 3 35 31 33.0 33.2 -0.2
11 2 4 35 37 36.0 33.2 2.8
12 2 5 35 29 32.0 33.2 -1.2
13 2 6 35 35 35.0 33.2 1.8
14 2 7 35 31 33.0 33.2 -0.2
15 2 8 35 30 32.5 33.2 -0.7
16 2 9 35 41 38.0 33.2 4.8
17 2 10 35 31 33.0 33.2 -0.2
18 3 4 31 37 34.0 33.2 0.8
19 3 5 31 29 30.0 33.2 -3.2
20 3 6 31 35 33.0 33.2 -0.2
21 3 7 31 31 31.0 33.2 -2.2
22 3 8 31 30 30.5 33.2 -2.7
23 3 9 31 41 36.0 33.2 2.8
24 3 10 31 31 31.0 33.2 -2.2
25 4 5 37 29 33.0 33.2 -0.2
26 4 6 37 35 36.0 33.2 2.8
27 4 7 37 31 34.0 33.2 0.8
28 4 8 37 30 33.5 33.2 0.3
29 4 9 37 41 39.0 33.2 5.8
30 4 10 37 31 34.0 33.2 0.8
31 5 6 29 35 32.0 33.2 -1.2
32 5 7 29 31 30.0 33.2 -3.2
33 5 8 29 30 29.5 33.2 -3.7
34 5 9 29 41 35.0 33.2 1.8
35 5 10 29 31 30.0 33.2 -3.2
36 6 7 35 31 33.0 33.2 -0.2
37 6 8 35 30 32.5 33.2 -0.7
38 6 9 35 41 38.0 33.2 4.8
39 6 10 35 31 33.0 33.2 -0.2
40 7 8 31 30 30.5 33.2 -2.7
41 7 9 31 41 36.0 33.2 2.8
42 7 10 31 31 31.0 33.2 -2.2
43 8 9 30 41 35.5 33.2 2.3
44 8 10 30 31 30.5 33.2 -2.7
45 9 10 41 31 36.0 33.2 2.8
paste("La media poblacional es: ", media.pob, " y la media de la edad de la distribución muestral es: ", mean(muestras$`Media muestra`))
## [1] "La media poblacional es:  33.2  y la media de la edad de la distribución muestral es:  33.2"

interpretacion

Finalizamos el semestre con este caso numero 23, en el cual tratamos con el tema del teorema del limite central, El teorema describe la distribución de la media de una muestra aleatoria proveniente de una población con varianza finita. El problema nos plantea que tenemos que cargar 1000000 datos, este conjunto tiene edades, de los cuales tenemos que la media es de 35 años, pero si sacamos la desviacion estandar obtendremos 5,lo mas importante y sobre todo lo visual, vamos a sacar los histogramas, en los cuales se puede obtener que 150000 personas estan en la media antes comentada, tambien se debe tomar en cuenta que los grupos de personas son de 500, en los cuales la media de la edad de la poblacion esta entre los 33 y 35 años de edad, esta es una forma bastante util y rapida de obtener resultados precisos sin nesecidad de manejar totalmente los datos