Inferencia Estadistica
Oscar Antonio Noguera
2023-04-04
Para realizar la práctica
# Acceder a la Base de Datos de la Encuesta Permanente de Hogares (EPH)2019.
url.eph.2019 = "https://www.ine.gov.py/datos/encuestas/eph/Poblacion/EPH-2019/data/4edb7reg02_ephc2019.csv"
# Guardar los datos de la Encuesta Permanente de Hogares (EPH)2019 en el objeto data.eph.2019
data.eph.2019 = read.csv(url.eph.2019,sep = ";",header = T)Ahora seleccionamos las variables con las que trabajaremos de la EPH 2019.
# Visualizar los nombres de las variables en data.eph.2019
names(data.eph.2019)## [1] "UPM" "NVIVI" "NHOGA" "DPTOREP" "AREA" "L02"
## [7] "P02" "P03" "P04" "P04A" "P04B" "P05C"
## [13] "P05P" "P05M" "P06" "P08D" "P08M" "P08A"
## [19] "P09" "P10A" "P10AB" "P10Z" "P11A" "P11AB"
## [25] "P11Z" "P12" "A01" "A01A" "A02" "A03"
## [31] "A04" "A04A" "A05" "A07" "A08" "A10"
## [37] "A11A" "A11M" "A11S" "A12" "A13REC" "A14REC"
## [43] "A15" "A16" "A17A" "A17M" "A17S" "A18"
## [49] "B01REC" "B02REC" "B03LU" "B03MA" "B03MI" "B03JU"
## [55] "B03VI" "B03SA" "B03DO" "B04" "B05" "B06"
## [61] "B07A" "B07M" "B07S" "B08" "B09A" "B09M"
## [67] "B09S" "B10" "B11" "B12" "B12A" "B12B"
## [73] "B12C" "B13" "B14" "B15" "B16G" "B16U"
## [79] "B16D" "B16T" "B17" "B18AG" "B18AU" "B18BG"
## [85] "B18BU" "B19" "B20G" "B20U" "B20D" "B20T"
## [91] "B21" "B22" "B23" "B24" "B25" "B26"
## [97] "B271" "B272" "B28" "B29" "B30" "B31"
## [103] "C01REC" "C02REC" "C03" "C04" "C05" "C06"
## [109] "C07" "C08" "C09" "C101" "C102" "C11G"
## [115] "C11U" "C11D" "C11T" "C12" "C13AG" "C13AU"
## [121] "C13BG" "C13BU" "C14" "C14A" "C14B" "C14C"
## [127] "C15" "C16REC" "C17REC" "C18" "C18A" "C18B"
## [133] "C19" "D01" "D02" "D03" "D04" "D05"
## [139] "E01A" "E01B" "E01C" "E01D" "E01E" "E01F"
## [145] "E01G" "E01H" "E01I" "E01J" "E01K" "E01L"
## [151] "E01M" "ED01" "ED02" "ED03" "ED0504" "ED06C"
## [157] "ED08" "ED09" "ED10" "ED11B1" "ED11B2" "ED11B3"
## [163] "ED11B4" "ED11B5" "ED11B6" "ED11B7" "ED11B8" "ED11B9"
## [169] "ED11C1" "ED11D1" "ED11E1" "ED11F1" "ED11F1A" "ED11F1B"
## [175] "ED11G1" "ED11G1A" "ED11G1B" "ED11H1" "ED11H1A" "ED11H1B"
## [181] "ED12" "ED13" "ED14" "ED14A" "ED15" "S01A"
## [187] "S01B" "S02" "S03" "S04" "S05" "S06"
## [193] "S07" "S08" "S09" "CATE_PEA" "TAMA_PEA" "OCUP_PEA"
## [199] "RAMA_PEA" "HORAB" "HORABC" "HORABCO" "PEAD" "PEAA"
## [205] "TIPOHOGA" "FEX" "NJEF" "NCON" "NPAD" "NMAD"
## [211] "TIC01" "TIC02" "TIC03" "TIC0401" "TIC0402" "TIC0403"
## [217] "TIC0404" "TIC0405" "TIC0406" "TIC0407" "TIC0408" "TIC0409"
## [223] "TIC0501" "TIC0502" "TIC0503" "TIC0504" "TIC0505" "TIC0506"
## [229] "TIC0507" "TIC0508" "TIC0509" "TIC0510" "TIC0511" "TIC0512"
## [235] "TIC0513" "TIC06" "añoest" "ra06ya09" "e01aimde" "e01bimde"
## [241] "e01cimde" "e01dde" "e01ede" "e01fde" "e01gde" "e01hde"
## [247] "e01ide" "e01jde" "e01kde" "e01lde" "e01mde" "e01kjde"
## [253] "e02bde" "ipcm" "pobrezai" "pobnopoi" "quintili" "decili"
## [259] "quintiai" "decilai"Seleccionar las variables y etiquetar según corresponda
data.eph.2019.fil <- subset(data.eph.2019, TIC0509!=9 & TIC0509!="NA"& P02>=18,select =c(P06,TIC0509,P02))
#Etiquetar la variable Sexo
data.eph.2019.fil$Sexo <- factor(data.eph.2019.fil$P06, labels = c("Hombres","Mujeres"))
#Etiquetar la variable,En los últimos 3 meses, utilizó Internet para transacción bancaria
data.eph.2019.fil$Tbancaria <- factor(data.eph.2019.fil$TIC0509, labels = c("Si","No"))
#summary
summary(data.eph.2019.fil)## P06 TIC0509 P02 Sexo Tbancaria
## Min. :1.000 Min. :1.000 Min. :18.00 Hombres:3898 Si: 589
## 1st Qu.:1.000 1st Qu.:6.000 1st Qu.:25.00 Mujeres:4139 No:7448
## Median :6.000 Median :6.000 Median :34.00
## Mean :3.575 Mean :5.634 Mean :35.96
## 3rd Qu.:6.000 3rd Qu.:6.000 3rd Qu.:45.00
## Max. :6.000 Max. :6.000 Max. :88.00Estadísticas Descriptivas
# Tabla de frecuencia absoluta
tabla.sexo.tbancaria<- xtabs(~Sexo+Tbancaria,data = data.eph.2019.fil)
tabla.sexo.tbancaria## Tbancaria
## Sexo Si No
## Hombres 318 3580
## Mujeres 271 3868# Tabla de frecuencia relativa (proporciones)
tabla.sexo.tbancaria_prop <- prop.table(tabla.sexo.tbancaria,margin = 1)
addmargins(tabla.sexo.tbancaria_prop,margin = 2)## Tbancaria
## Sexo Si No Sum
## Hombres 0.08158030 0.91841970 1.00000000
## Mujeres 0.06547475 0.93452525 1.00000000# Gráfico de barras para frecuencia absoluta
barplot(t(tabla.sexo.tbancaria), beside = T, legend.text = T)
# Gráfico de barras para frecuencia relativa (proporciones)
barplot(t(prop.table(tabla.sexo.tbancaria,margin = 1)), beside = T, legend.text = T)
Contraste de hipótesis
\(H_0:\) La proporción de hombres que en los últimos 3 meses, utilizó Internet para transacción bancaria no es mayor que la de mujeres.
\(H_1:\) La proporción de hombres que en los últimos 3 meses, utilizó Internet para transacción bancaria es mayor que la de mujeres.
Utilizaremos la Distribución muestral de Diferencia de Proporciones para contrastar las hipótesis.
Utilizar la estadística z
Criterios de decisión
Para un \(\alpha=0,05\), si \(z\le 1,645\) no se rechaza la \(H_0\).
Para un \(\alpha=0,05\), si \(z > 1,645\) se rechaza la \(H_0\).
Calcular el estadístico de prueba
x_H <- tabla.sexo.tbancaria[1,1]
x_H## [1] 318x_M <- tabla.sexo.tbancaria[2,1]
x_M## [1] 271n_H <- sum(tabla.sexo.tbancaria[1,])
n_H## [1] 3898n_M <- sum(tabla.sexo.tbancaria[2,])
n_M## [1] 4139pest_H = tabla.sexo.tbancaria_prop[1,1]
pest_H## [1] 0.0815803pest_M = tabla.sexo.tbancaria_prop[2,1]
pest_M## [1] 0.06547475pest_gral <- (x_H+x_M)/(n_H+n_M)
pest_gral## [1] 0.07328605Calcular el valor de z
z <- (pest_H-pest_M)/sqrt(pest_gral*(1-pest_gral)*(1/n_H+1/n_M))
z## [1] 2.76894Conclusión: Observamos que el valor de \(z=2,76894>1,645\). Por tanto, se rechaza la \(H_0\), esto significa que existe evidencia estadistica para afirmar con un nivel de significancia del 0,05, que la proporción de hombres que en los últimos 3 meses, utilizó Internet para transacción bancaria es mayor que la de mujeres en el año 2019.
Utilizar el p valor
Criterios de decisión
Para un \(\alpha=0,05\), si \(p_{valor} > 0,05\) no se rechaza la \(H_0\).
Para un \(\alpha=0,05\), si \(p_{valor} \le 0,05\) se rechaza la \(H_0\).
# Prueba unilateral derecha
prop.test(tabla.sexo.tbancaria, alternative = "greater")##
## 2-sample test for equality of proportions with continuity correction
##
## data: tabla.sexo.tbancaria
## X-squared = 7.4317, df = 1, p-value = 0.003204
## alternative hypothesis: greater
## 95 percent confidence interval:
## 0.006264758 1.000000000
## sample estimates:
## prop 1 prop 2
## 0.08158030 0.06547475Conclusión: Como la prueba estadística basada en la diferencia entre proporciones arroja un p valor casi nulo, entonces rechazamos la hipoesis nula. Afirmar que con un nivel de significancia del 0,05, la proporción de hombres que en los últimos 3 meses, utilizó Internet para transacción bancaria es mayor que la de mujeres, en el año 2019.
# Acceder a la Base de Datos de la Encuesta Permanente de Hogares (EPH)2020.
url.eph.2020 = "https://www.ine.gov.py/datos/encuestas/eph/Poblacion/EPH-2020/data/55f07reg02_ephc2020.csv"
# Guardar los datos de la Encuesta Permanente de Hogares (EPH)2020 en el objeto data.eph.2020
data.eph.2020 = read.csv(url.eph.2020,sep = ";",header = T)# Visualizar los nombres de las variables en data.eph.2020
names(data.eph.2020)## [1] "UPM" "NVIVI"
## [3] "NHOGA" "DPTOREP"
## [5] "AREA" "L02"
## [7] "P02" "P03"
## [9] "P04" "P04A"
## [11] "P04B" "P05C"
## [13] "P05P" "P05M"
## [15] "P06" "P08D"
## [17] "P08M" "P08A"
## [19] "P09" "P10A"
## [21] "P10AB" "P10Z"
## [23] "P11A" "P11AB"
## [25] "P11Z" "P12"
## [27] "A01" "A01A"
## [29] "A02" "A03"
## [31] "A04" "A04B"
## [33] "A04A" "A05"
## [35] "A07" "A08"
## [37] "A10" "A11A"
## [39] "A11M" "A11S"
## [41] "A12" "A13REC"
## [43] "A14REC" "A15"
## [45] "A16" "A17A"
## [47] "A17M" "A17S"
## [49] "A18" "A18A"
## [51] "B01REC" "B02REC"
## [53] "B03LU" "B03MA"
## [55] "B03MI" "B03JU"
## [57] "B03VI" "B03SA"
## [59] "B03DO" "B04"
## [61] "B05" "B05A"
## [63] "B06" "B07A"
## [65] "B07M" "B07S"
## [67] "B08" "B09A"
## [69] "B09M" "B09S"
## [71] "B10" "B11"
## [73] "B12" "B12A"
## [75] "B12B" "B12C"
## [77] "B13" "B14"
## [79] "B15" "B16G"
## [81] "B16U" "B16D"
## [83] "B16T" "B17"
## [85] "B18AG" "B18AU"
## [87] "B18BG" "B18BU"
## [89] "B19" "B20G"
## [91] "B20U" "B20D"
## [93] "B20T" "B21"
## [95] "B22" "B23"
## [97] "B24" "B25"
## [99] "B26" "B271"
## [101] "B272" "B28"
## [103] "B29" "B30"
## [105] "B31" "C01REC"
## [107] "C02REC" "C03"
## [109] "C04" "C05"
## [111] "C06" "C07"
## [113] "C08" "C09"
## [115] "C101" "C102"
## [117] "C11G" "C11U"
## [119] "C11D" "C11T"
## [121] "C12" "C13AG"
## [123] "C13AU" "C13BG"
## [125] "C13BU" "C14"
## [127] "C14A" "C14B"
## [129] "C14C" "C15"
## [131] "C16REC" "C17REC"
## [133] "C18" "C18A"
## [135] "C18B" "C19"
## [137] "D01" "D02"
## [139] "D03" "D04"
## [141] "D05" "E01A"
## [143] "E01B" "E01C"
## [145] "E01D" "E01E"
## [147] "E01F" "E01G"
## [149] "E01H" "E01I"
## [151] "E01J" "E01K"
## [153] "E01L" "E01M"
## [155] "E02C1" "E02D1"
## [157] "E02D2" "E02B"
## [159] "E02G1" "E02G2"
## [161] "E02F" "ED01"
## [163] "ED02" "ED03"
## [165] "ED0504" "ED06C"
## [167] "ED08" "ED09"
## [169] "ED10" "ED11F1"
## [171] "ED11F1A" "ED11GH1"
## [173] "ED11GH1A" "ED12"
## [175] "ED13" "ED14"
## [177] "ED14A" "ED15"
## [179] "S01A" "S01B"
## [181] "S02" "S03"
## [183] "S03A" "S03B"
## [185] "S03C" "S04"
## [187] "S05" "S06"
## [189] "S07" "S08"
## [191] "S09" "CATE_PEA"
## [193] "TAMA_PEA" "OCUP_PEA"
## [195] "RAMA_PEA" "HORAB"
## [197] "HORABC" "HORABCO"
## [199] "PEAD" "PEAA"
## [201] "informalidad" "TIPOHOGA"
## [203] "FEX" "NJEF"
## [205] "NCON" "NPAD"
## [207] "NMAD" "TIC01"
## [209] "TIC02" "TIC03"
## [211] "TIC0401" "TIC0402"
## [213] "TIC0403" "TIC0404"
## [215] "TIC0405" "TIC0406"
## [217] "TIC0407" "TIC0408"
## [219] "TIC0409" "TIC0501"
## [221] "TIC0502" "TIC0503"
## [223] "TIC0504" "TIC0505"
## [225] "TIC0506" "TIC0507"
## [227] "TIC0508" "TIC0509"
## [229] "TIC0510" "TIC0511"
## [231] "TIC0512" "TIC0513"
## [233] "TIC06" "TIC07"
## [235] "añoest" "ra06ya09"
## [237] "e01aimde" "e01bimde"
## [239] "e01cimde" "e01dde"
## [241] "e01ede" "e01fde"
## [243] "e01gde" "e01hde"
## [245] "e01ide" "e01jde"
## [247] "e01kde" "e01lde"
## [249] "e01mde" "e01kjde"
## [251] "e02bde" "ingrevasode"
## [253] "ingreñangarekode" "ingrepytyvõde"
## [255] "ingresect_privadode" "ingreadicional_tekoporãde"
## [257] "otroingre_subside" "ipcm"
## [259] "pobrezai" "pobnopoi"
## [261] "quintili" "decili"
## [263] "quintiai" "decilai"Seleccionar las variables y etiquetar según corresponda
data.eph.2020.fil <- subset(data.eph.2020, TIC0509!=9 & TIC0509!="NA"& P02>=18,select =c(P06,TIC0509,P02))
#Etiquetar la variable Sexo
data.eph.2020.fil$Sexo <- factor(data.eph.2020.fil$P06, labels = c("Hombres","Mujeres"))
#Etiquetar la variable,En los últimos 3 meses, utilizó Internet para transacción bancaria
data.eph.2020.fil$Tbancaria <- factor(data.eph.2020.fil$TIC0509, labels = c("Si","No"))
#summary
summary(data.eph.2020.fil)## P06 TIC0509 P02 Sexo Tbancaria
## Min. :1.000 Min. :1.000 Min. :18.00 Hombres:3950 Si: 686
## 1st Qu.:1.000 1st Qu.:6.000 1st Qu.:25.00 Mujeres:4238 No:7502
## Median :6.000 Median :6.000 Median :35.00
## Mean :3.588 Mean :5.581 Mean :36.85
## 3rd Qu.:6.000 3rd Qu.:6.000 3rd Qu.:46.00
## Max. :6.000 Max. :6.000 Max. :89.00Estadísticas Descriptivas
# Tabla de frecuencia absoluta
tabla.sexo.tbancaria<- xtabs(~Sexo+Tbancaria,data = data.eph.2020.fil)
tabla.sexo.tbancaria## Tbancaria
## Sexo Si No
## Hombres 377 3573
## Mujeres 309 3929# Tabla de frecuencia relativa (proporciones)
tabla.sexo.tbancaria_prop <- prop.table(tabla.sexo.tbancaria,margin = 1)
addmargins(tabla.sexo.tbancaria_prop,margin = 2)## Tbancaria
## Sexo Si No Sum
## Hombres 0.09544304 0.90455696 1.00000000
## Mujeres 0.07291175 0.92708825 1.00000000# Gráfico de barras para frecuencia absoluta
barplot(t(tabla.sexo.tbancaria), beside = T, legend.text = T)
# Gráfico de barras para frecuencia relativa (proporciones)
barplot(t(prop.table(tabla.sexo.tbancaria,margin = 1)), beside = T, legend.text = T)
Contraste de hipótesis
\(H_0:\) La proporción de hombres que en los últimos 3 meses, utilizó Internet para transacción bancaria no es mayor que la de mujeres.
\(H_1:\) La proporción de hombres que en los últimos 3 meses, utilizó Internet para transacción bancaria es mayor que la de mujeres.
Utilizaremos la distribución muestral de diferencia de proporciones para contrastar las hipótesis.
Utilizar la estadística z
Criterios de decisión
Para un \(\alpha=0,05\), si \(z\le 1,645\) no se rechaza la \(H_0\).
Para un \(\alpha=0,05\), si \(z > 1,645\) se rechaza la \(H_0\).
Calcular el estadístico de prueba
x_H <- tabla.sexo.tbancaria[1,1]
x_H## [1] 377x_M <- tabla.sexo.tbancaria[2,1]
x_M## [1] 309n_H <- sum(tabla.sexo.tbancaria[1,])
n_H## [1] 3950n_M <- sum(tabla.sexo.tbancaria[2,])
n_M## [1] 4238pest_H = tabla.sexo.tbancaria_prop[1,1]
pest_H## [1] 0.09544304pest_M = tabla.sexo.tbancaria_prop[2,1]
pest_M## [1] 0.07291175pest_gral <- (x_H+x_M)/(n_H+n_M)
pest_gral## [1] 0.08378114Calcular el valor de z
z <- (pest_H-pest_M)/sqrt(pest_gral*(1-pest_gral)*(1/n_H+1/n_M))
z## [1] 3.677082Conclusión: Como el valor de \(z=3,677085>1,645\). Por tanto, se rechaza la \(H_0\), esto significa que existe evidencia estadistica para afirmar que con un nivel de significancia del 0,05, la proporción de hombres que en los últimos 3 meses, utilizó Internet para transacción bancaria es mayor que la de mujeres en el año 2020.
Utilizar el p valor
Criterios de decisión
Para un \(\alpha=0,05\), si \(p_{valor} > 0,05\) no se rechaza la \(H_0\).
Para un \(\alpha=0,05\), si \(p_{valor} \le 0,05\) se rechaza la \(H_0\).
# Prueba unilateral derecha
prop.test(tabla.sexo.tbancaria, alternative = "greater")##
## 2-sample test for equality of proportions with continuity correction
##
## data: tabla.sexo.tbancaria
## X-squared = 13.229, df = 1, p-value = 0.0001378
## alternative hypothesis: greater
## 95 percent confidence interval:
## 0.01217301 1.00000000
## sample estimates:
## prop 1 prop 2
## 0.09544304 0.07291175Conclusión: Como la prueba estadística basada en la diferencia entre proporciones arroja un p valor casi nulo, entonces rechazamos la hipoesis nula. Afirmar que con un nivel de significancia del 0,05, la proporción de hombres que en los últimos 3 meses, utilizó Internet para transacción bancaria es mayor que la de mujeres, en el año 2020.
Conclusión General: Para ambos años (2019 y 2020) se mantiene la diferencia significativa estadísticamente comprobadas mediante las pruebas de hipotesis, con un nivel de significancia del 0,05; la proporción de hombres que en los últimos 3 meses, utilizó Internet para transacción bancaria es mayor que la de mujeres.
Teorema central del límite
El teorema central del límite (TCL) es una teoría estadística que establece que, dada una muestra aleatoria suficientemente grande de la población, la distribución de las medias muestrales seguirá una distribución normal.
#Entonces se procede a realizar 10000 replicaciones para cada tamaño de muestra y en base a una variable aleatoria con Distribución Exponencial
rexpon<-rexp(200000,10) #variable aleatoria con distribución exponencial
meanP <- mean(rexpon) # media parámetro poblacional
means10<-NULL
for(i in 1:20000){
means10<-c(means10,mean(sample(rexpon,size = 10)))
} #calculamos la media para 20000 muestras aleatorias de n=10
means50<-NULL
for(i in 1:20000){
means50<-c(means50,mean(sample(rexpon,size = 50)))
} #calculamos la media para 20000 muestras aleatorias de n=50
means100<-NULL
for(i in 1:20000){
means100<-c(means100,mean(sample(rexpon,size = 100)))
} #calculamos la media para 20000 muestras aleatorias de n=100
means500<-NULL
for(i in 1:20000){
means500<-c(means500,mean(sample(rexpon,size = 500)))
} #calculamos la media para 20000 muestras aleatorias de n=500
means1000<-NULL
for(i in 1:20000){
means1000<-c(means1000,mean(sample(rexpon,size = 1000)))
} #calculamos la media para 20000 muestras aleatorias de n=1000
means2000<-NULL
for(i in 1:20000){
means2000<-c(means2000,mean(sample(rexpon,size = 2000)))
} #calculamos la media para 20000 muestras aleatorias de n=2000
means3000<-NULL
for(i in 1:20000){
means3000<-c(means3000,mean(sample(rexpon,size = 3000)))
} #calculamos la media para 20000 muestras aleatorias de n=3000
par(mfrow=c(1,2))
par(mfrow=c(2,2))
hist(rexpon)
hist(means10)
hist(means50)
hist(means100)
hist(means1000)
hist(means2000)
hist(means3000)
n <-c(rep(10,20000),rep(50,20000),rep(100,20000),rep(500,20000),rep(1000,20000),rep(2000,20000),
rep(3000,20000))
diferencias <-c(meanP-means10, meanP-means50, meanP-means100, meanP-means500,meanP-means1000,
meanP-means2000, meanP-means3000)
plot(n,diferencias)
abline(h = 0,col="red")
Ley de los grandes números: a medida que aumenta el tamaño de la muestra, decrece la diferencia entre el estadístico muestral y el parámetro poblacional.
Con esta simulación se puede ver que al aumentar el n de la muestra, si sacamos una muestra al azar, tendremos mayor seguridad de que el estadístico tienda a converger eventualmente con el parámetro poblacional.