Teorema del limite 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.

1. Cargar librerías

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)  # Para gráficos
library(knitr)    # Para formateo de datos
library(fdth)     # Para tablas de frecuencias

## 
## 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)   # Para combinaciones y permutaciones

## 
## Attaching package: 'gtools'

## The following object is masked from 'package:mosaic':
## 
##     logit

library(Rmpfr)    # Para factoriales de números muy grandes

## Warning: package 'Rmpfr' was built under R version 4.0.3

## Loading required package: gmp

## 
## 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

library(fdth)     # Para tablas de frecuencias

2. Cargar datos

Experimentar con una población de 1000000 de edades de personas Se simula una población bajo una condición de distribución normal de \(N=1000000\) (un millón) de personas con media de edad de 35 años y desviación estándar de 5. Se muestran los parámetros principales de la edad de la población.

N <- 1000000; 

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

summary(edad.poblacion)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##      11      32      35      35      38      59

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] 38 44 27 39 33 38 35 47 39 37 37 25 35 29 31 39 31 37 37 32 35 33 41 36 35
## [26] 28 28 38 28 37 24 29 25 46 29 39 24 42 42 28 37 34 41 36 28 31 36 34 43 43

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] 37 35 35 38 31 34 45 34 41 31 28 33 36 39 33 45 36 40 29 39 45 37 43 41 38
## [26] 41 32 32 30 39 30 35 35 36 31 35 28 33 43 37 39 21 28 39 36 30 34 41 30 39

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.00258

## [1] 5.007848

Determinar medias y desviaciones muestrales.

Determinar cinco muestras de \(n=500\) casos por medio de la función sample(), se guardan en un data.frame llamado muestras. Se visualizan los estadísticos principales por medio de la función summary() Se utiliza un ciclo para determinar las medias de cada muestra. Se construye un data frame con los valores de los errores estadísticos.

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.   :22.00   Min.   :21.00   Min.   :22.00   Min.   :20.00  
##  1st Qu.:32.00   1st Qu.:32.00   1st Qu.:31.00   1st Qu.:32.00  
##  Median :35.00   Median :35.00   Median :35.00   Median :35.00  
##  Mean   :35.18   Mean   :35.11   Mean   :34.99   Mean   :35.06  
##  3rd Qu.:39.00   3rd Qu.:38.25   3rd Qu.:38.00   3rd Qu.:39.00  
##  Max.   :53.00   Max.   :48.00   Max.   :52.00   Max.   :51.00  
##        m5       
##  Min.   :20.00  
##  1st Qu.:31.00  
##  Median :34.00  
##  Mean   :34.27  
##  3rd Qu.:38.00  
##  Max.   :52.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
36	43	39	34	34
22	37	33	37	37
43	36	37	33	41
34	38	30	31	34
47	36	33	34	33
44	35	36	51	32
36	36	39	32	42
41	33	31	28	38
36	42	41	38	32
38	43	40	32	22

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
36	43	39	34	34
22	37	33	37	37
43	36	37	33	41
34	38	30	31	34
47	36	33	34	33
44	35	36	51	32
36	36	39	32	42
41	33	31	28	38
36	42	41	38	32
38	43	40	32	22

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.00258	35.178	0.175424
35.00258	35.114	0.111424
35.00258	34.992	-0.010576
35.00258	35.058	0.055424
35.00258	34.274	-0.728576

Visualizando la población y la muestra

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")

Se recapitulan los datos iniciales
N = 1000000, tamaño de la población
n = 500, tamaño de la muestra
edad.poblacion es la edad conocida y recabada de las personas.
media.pob es la media de toda la población,
desv.std es la desviación estándar de toda la población.

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. 
##      11      32      35      35      38      59

media.pob; desv.std

## [1] 35.00258

## [1] 5.007848

\(C(Nn)=N!/n!⋅(N−n)!\)

#factorialMpfr(N) / (factorialMpfr(n) * (factorialMpfr(N-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 33 33 40 38 35 37 32 26 31

media.pob <- mean(edad.poblacion)
desv.std <- sd(edad.poblacion)

media.pob; desv.std

## [1] 33.7

## [1] 4.001389

n.combinaciones <- factorialMpfr(N) / (factorialMpfr(n) * (factorialMpfr(N-n)))
as.integer(n.combinaciones)

## [1] 45

Determinando muestras en grupos de 2

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	33	32.5	33.7	-1.2
2	1	3	32	33	32.5	33.7	-1.2
3	1	4	32	40	36.0	33.7	2.3
4	1	5	32	38	35.0	33.7	1.3
5	1	6	32	35	33.5	33.7	-0.2
6	1	7	32	37	34.5	33.7	0.8
7	1	8	32	32	32.0	33.7	-1.7
8	1	9	32	26	29.0	33.7	-4.7
9	1	10	32	31	31.5	33.7	-2.2
10	2	3	33	33	33.0	33.7	-0.7
11	2	4	33	40	36.5	33.7	2.8
12	2	5	33	38	35.5	33.7	1.8
13	2	6	33	35	34.0	33.7	0.3
14	2	7	33	37	35.0	33.7	1.3
15	2	8	33	32	32.5	33.7	-1.2
16	2	9	33	26	29.5	33.7	-4.2
17	2	10	33	31	32.0	33.7	-1.7
18	3	4	33	40	36.5	33.7	2.8
19	3	5	33	38	35.5	33.7	1.8
20	3	6	33	35	34.0	33.7	0.3
21	3	7	33	37	35.0	33.7	1.3
22	3	8	33	32	32.5	33.7	-1.2
23	3	9	33	26	29.5	33.7	-4.2
24	3	10	33	31	32.0	33.7	-1.7
25	4	5	40	38	39.0	33.7	5.3
26	4	6	40	35	37.5	33.7	3.8
27	4	7	40	37	38.5	33.7	4.8
28	4	8	40	32	36.0	33.7	2.3
29	4	9	40	26	33.0	33.7	-0.7
30	4	10	40	31	35.5	33.7	1.8
31	5	6	38	35	36.5	33.7	2.8
32	5	7	38	37	37.5	33.7	3.8
33	5	8	38	32	35.0	33.7	1.3
34	5	9	38	26	32.0	33.7	-1.7
35	5	10	38	31	34.5	33.7	0.8
36	6	7	35	37	36.0	33.7	2.3
37	6	8	35	32	33.5	33.7	-0.2
38	6	9	35	26	30.5	33.7	-3.2
39	6	10	35	31	33.0	33.7	-0.7
40	7	8	37	32	34.5	33.7	0.8
41	7	9	37	26	31.5	33.7	-2.2
42	7	10	37	31	34.0	33.7	0.3
43	8	9	32	26	29.0	33.7	-4.7
44	8	10	32	31	31.5	33.7	-2.2
45	9	10	26	31	28.5	33.7	-5.2

\(μx¯=∑i=1Nx¯=x1¯+x2¯+x3¯...xn¯\)

Entonces … la media de la distribución muestral comparado con la media poblaciónal.

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.7  y la media de la edad de la distribución muestral es:  33.7"

Distribución de frecuencia de las muestras

tabla.frec.muestras <- fdt(muestras$`Media muestra`, )
kable(tabla.frec.muestras, caption = "Tabla de frecuencias de la medias de edades de cada muestra")

Tabla de frecuencias de la medias de edades de cada muestra

Class limits	f	rf	rf(%)	cf	cf(%)
[28.215,29.811)	5	0.1111111	11.111111	5	11.11111
[29.811,31.408)	1	0.0222222	2.222222	6	13.33333
[31.408,33.004)	14	0.3111111	31.111111	20	44.44444
[33.004,34.601)	8	0.1777778	17.777778	28	62.22222
[34.601,36.197)	10	0.2222222	22.222222	38	84.44444
[36.197,37.794)	5	0.1111111	11.111111	43	95.55556
[37.794,39.39)	2	0.0444444	4.444444	45	100.00000

	x
start	28.215000
end	39.390000
h	1.596429
right	0.000000

muestras$media.muestra <- muestras$`Media muestra`
barplot(height = tabla.frec.muestras$table$f, names.arg = tabla.frec.muestras$table$`Class limits`)

Teorema del limite central

Daniela Deshiré Tinoco Ceniceros

11/1/2021

Objetivo