Objetivo

Determinar y simular muestreos.

Descripcion

Con un conjunto de datos utilizar mecanismos de programación para determinar muestreos mediante técnicas de aleatorio simple, aleatorio sistemático, aleatorio estratificado y por conglomerados.

Proceso:

Paso 1: Cargar librerias

library(dplyr)
library(mosaic)
library(readr)
library(ggplot2)
library(knitr)
library(fdth)
library(leaflet) # Visualizar mapas

Paso 2: Cargar datos

source("https://raw.githubusercontent.com/rpizarrog/probabilidad-y-estad-stica/master/construir%20datos%20y%20funciones%20caso%209.r", encoding = "UTF-8")

kable(head(personas, 10), caption = "Se cargaron 10 registros de las primeras 10 personas")
Se cargaron 10 registros de las primeras 10 personas
nombres generos ajedrez beisbol tiro.arco pesas futbol softbol atletismo folklorico tahitiano teatro rondalla pantomima
JUAN M NO NO NO SI NO SI NO NO NO NO NO SI
JOSÉ LUIS M NO NO NO NO NO NO NO SI NO NO NO NO
JOSÉ M NO SI NO SI NO NO NO NO NO NO SI SI
MARÍA GUADALUPE F NO SI NO NO NO NO NO NO NO NO SI SI
FRANCISCO M NO NO NO NO NO NO SI NO NO NO NO NO
GUADALUPE F NO NO NO NO NO NO NO NO NO NO NO NO
MARÍA F NO SI NO NO SI NO NO NO NO NO NO NO
JUANA F NO NO NO NO SI NO NO SI NO NO NO NO
ANTONIO M NO NO NO NO NO NO NO NO NO NO NO NO
JESÚS M NO NO SI NO NO SI NO NO SI NO NO NO 
kable(tail(personas, 10), caption = "Se cargaron los ultimos registros de las ultimas 10 personas")
Se cargaron los ultimos registros de las ultimas 10 personas
nombres generos ajedrez beisbol tiro.arco pesas futbol softbol atletismo folklorico tahitiano teatro rondalla pantomima
91 ANDREA F NO NO NO NO NO NO NO NO NO NO NO SI
92 ISABEL F NO NO NO NO NO NO NO NO NO NO NO NO
93 MARÍA TERESA F NO SI NO NO SI NO NO SI NO NO NO NO
94 IRMA F SI SI NO NO NO NO NO NO NO NO NO NO
95 CARMEN F NO NO NO NO NO NO NO NO NO NO NO NO
96 LUCÍA F NO SI NO SI NO NO NO SI NO NO SI SI
97 ADRIANA F NO NO NO NO NO NO SI NO NO NO NO NO
98 AGUSTÍN M NO SI NO NO NO NO NO NO SI NO NO NO
99 MARÍA DE LA LUZ F NO NO NO NO NO NO SI NO NO NO NO NO
100 GUSTAVO M NO NO NO NO NO NO NO SI NO NO NO NO

2.1: Se van a cargar los siguientes datos de los primeros y ultimos 20 alumnos del instituto.

  • No de control (modificado y no real),
  • Número Conesucutivo de alumno
  • Semestre que cursa
  • Créditos aprobados
  • Carga académica que cursa
  • Promedio aritmético
  • Carrera
alumnos <- alumnos <- read_csv("https://raw.githubusercontent.com/rpizarrog/probabilidad-y-estad-stica/master/datos/promedios%20alumnos/datos%20alumnos%20promedios%20SEP%202020.csv")

kable(head(alumnos, 10), caption = "Datos de los primeros 10 alumnos")
Datos de los primeros 10 alumnos
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera
20190001 1 11 198 19 80.21 SISTEMAS
20190002 2 11 235 10 84.33 SISTEMAS
20190003 3 9 235 10 95.25 SISTEMAS
20190004 4 9 226 19 95.00 SISTEMAS
20190005 5 10 231 14 82.32 SISTEMAS
20190006 6 9 212 23 95.02 SISTEMAS
20190007 7 12 221 10 79.06 SISTEMAS
20190008 8 9 226 9 92.47 SISTEMAS
20190009 9 9 231 4 91.08 SISTEMAS
20190010 10 11 222 13 80.42 SISTEMAS 
kable(tail(alumnos, 10), caption = "Datos de los ultimos 10 alumnos")
Datos de los ultimos 10 alumnos
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera
20195920 5920 7 169 23 89.14 ADMINISTRACION
20195921 5921 5 109 26 87.83 ADMINISTRACION
20195922 5922 3 55 29 92.83 ADMINISTRACION
20195923 5923 2 23 23 88.60 ADMINISTRACION
20195924 5924 2 27 28 92.83 ADMINISTRACION
20195925 5925 7 94 13 80.95 ADMINISTRACION
20195926 5926 5 103 32 92.68 ADMINISTRACION
20195927 5927 4 79 34 86.18 ADMINISTRACION
20195928 5928 5 108 32 90.48 ADMINISTRACION
20195929 5929 7 169 32 92.33 ADMINISTRACION

Paso 3: Simular los muestreos

3.1: Muestreo aleatorio simple

  • Hay que encuestar a diez personas de 100 para hacerles alguna entrevista
N <- nrow(personas)
n <- 10
muestra <- sample(personas$nombres, n)
kable(muestra, caption = "La muestra de personas")
La muestra de personas
x
FRANCISCA
GUSTAVO
JORGE
PATRICIA
PEDRO
LUCÍA
ELIZABETH
JESÚS
ALEJANDRO
RAFAEL
  • Encontrar a 100 alumnos
N <- nrow(alumnos)
n <- 100
muestra <- sample(N, n)
kable(alumnos[muestra, ], caption = "La muestra de alumnos")
La muestra de alumnos
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera
20194973 4973 6 133 33 85.54 GESTION EMPRESARIAL
20195866 5866 1 NA 27 0.00 ADMINISTRACION
20191513 1513 6 67 34 78.60 BIOQUIMICA
20194076 4076 7 144 32 88.52 MECATRONICA
20192521 2521 9 222 23 86.40 ELECTRONICA
20195624 5624 3 55 29 96.67 ADMINISTRACION
20194985 4985 4 55 29 80.42 GESTION EMPRESARIAL
20195075 5075 5 116 32 87.71 GESTION EMPRESARIAL
20195041 5041 7 140 35 82.27 GESTION EMPRESARIAL
20190395 395 1 NA 27 0.00 SISTEMAS
20193795 3795 4 66 29 86.47 MECATRONICA
20195683 5683 1 NA 27 0.00 ADMINISTRACION
20191577 1577 9 165 16 78.86 CIVIL
20192306 2306 5 89 27 86.33 ELECTRICA
20193510 3510 3 41 24 76.80 MECANICA
20191415 1415 6 123 29 82.48 BIOQUIMICA
20190830 830 5 97 26 93.50 ARQUITECTURA
20190200 200 7 107 17 79.26 SISTEMAS
20195484 5484 11 257 5 87.44 ADMINISTRACION
20190025 25 11 230 15 84.02 SISTEMAS
20192596 2596 3 52 25 92.67 ELECTRONICA
20193863 3863 1 NA 25 0.00 MECATRONICA
20190074 74 10 230 15 83.94 SISTEMAS
20191933 1933 1 NA 27 0.00 CIVIL
20191691 1691 4 75 32 84.19 CIVIL
20192587 2587 5 90 20 83.50 ELECTRONICA
20190886 886 1 NA 26 0.00 ARQUITECTURA
20194827 4827 7 150 25 88.75 GESTION EMPRESARIAL
20194756 4756 9 230 15 91.77 GESTION EMPRESARIAL
20190663 663 7 151 23 85.22 ARQUITECTURA
20192503 2503 10 202 23 81.25 ELECTRONICA
20194892 4892 1 NA 27 0.00 GESTION EMPRESARIAL
20194549 4549 6 133 23 83.25 QUIMICA
20190308 308 4 83 29 91.00 SISTEMAS
20192139 2139 6 143 30 84.77 CIVIL
20191319 1319 7 124 34 83.15 BIOQUIMICA
20195755 5755 4 84 29 87.44 ADMINISTRACION
20195925 5925 7 94 13 80.95 ADMINISTRACION
20193632 3632 1 NA 26 0.00 MECANICA
20193546 3546 3 48 22 78.64 MECANICA
20191619 1619 9 225 10 84.85 CIVIL
20191632 1632 9 159 15 80.15 CIVIL
20194890 4890 7 170 35 87.44 GESTION EMPRESARIAL
20192090 2090 4 78 33 83.59 CIVIL
20191764 1764 1 NA 27 0.00 CIVIL
20190612 612 1 NA 26 0.00 ARQUITECTURA
20191097 1097 7 139 24 84.62 ARQUITECTURA
20190796 796 7 116 34 81.12 ARQUITECTURA
20190240 240 2 27 28 92.33 SISTEMAS
20191202 1202 1 NA 23 0.00 BIOQUIMICA
20194673 4673 12 219 16 89.93 GESTION EMPRESARIAL
20195370 5370 5 41 4 81.44 INFORMATICA
20191901 1901 5 117 31 87.08 CIVIL
20193696 3696 11 231 4 83.33 MECATRONICA
20193370 3370 11 225 10 81.86 MECANICA
20191197 1197 3 57 27 82.54 BIOQUIMICA
20193032 3032 3 55 29 89.00 INDUSTRIAL
20194867 4867 1 NA 27 0.00 GESTION EMPRESARIAL
20191967 1967 1 NA 27 0.00 CIVIL
20193638 3638 7 170 27 86.59 MECANICA
20190934 934 7 170 28 88.58 ARQUITECTURA
20194100 4100 9 225 5 87.96 QUIMICA
20195193 5193 6 138 33 86.21 GESTION EMPRESARIAL
20195450 5450 10 262 10 88.60 ADMINISTRACION
20191067 1067 1 NA 26 0.00 ARQUITECTURA
20193404 3404 10 172 18 81.13 MECANICA
20194217 4217 12 225 10 78.46 QUIMICA
20191449 1449 1 NA 23 0.00 BIOQUIMICA
20192720 2720 9 202 24 82.28 INDUSTRIAL
20195151 5151 1 NA 27 0.00 GESTION EMPRESARIAL
20193110 3110 1 NA 27 0.00 INDUSTRIAL
20191051 1051 6 127 24 88.19 ARQUITECTURA
20194783 4783 1 NA 27 0.00 GESTION EMPRESARIAL
20195643 5643 2 27 28 92.67 ADMINISTRACION
20194482 4482 2 25 30 82.00 QUIMICA
20194046 4046 1 NA 25 0.00 MECATRONICA
20192183 2183 2 27 30 83.50 CIVIL
20190659 659 1 NA 26 0.00 ARQUITECTURA
20195318 5318 1 NA 26 0.00 TIC
20192101 2101 2 23 25 80.80 CIVIL
20191758 1758 4 80 34 85.94 CIVIL
20192297 2297 5 94 33 84.77 ELECTRICA
20193793 3793 7 128 31 84.46 MECATRONICA
20190822 822 3 48 32 90.45 ARQUITECTURA
20190352 352 8 176 32 80.47 SISTEMAS
20193467 3467 3 42 32 82.30 MECANICA
20190443 443 7 160 34 90.34 SISTEMAS
20190241 241 5 112 25 91.63 SISTEMAS
20194569 4569 3 51 30 88.64 QUIMICA
20193456 3456 6 89 32 78.30 MECANICA
20195534 5534 8 177 34 86.89 ADMINISTRACION
20193666 3666 12 190 5 78.35 MECATRONICA
20192155 2155 2 22 26 93.40 CIVIL
20193527 3527 1 NA 26 0.00 MECANICA
20191607 1607 10 231 4 83.15 CIVIL
20194038 4038 5 105 24 88.57 MECATRONICA
20190090 90 4 49 32 82.64 SISTEMAS
20195706 5706 4 84 30 86.94 ADMINISTRACION
20190058 58 9 200 25 83.66 SISTEMAS
20190724 724 4 70 28 87.56 ARQUITECTURA

3.2: Muestreo aleatorio sistemático

N <- nrow(personas)
n = 10
saltos <- round(N / n, 0)
inicio <- round(sample(N, 1) / n, 0)
#inicio

cuales <- seq(from = inicio, to =N, by= saltos)
kable(personas[cuales, ], caption = "La muestra sistematizada de personas")
La muestra sistematizada de personas
nombres generos ajedrez beisbol tiro.arco pesas futbol softbol atletismo folklorico tahitiano teatro rondalla pantomima
10 JESÚS M NO NO SI NO NO SI NO NO SI NO NO NO
20 DANIEL M NO NO NO NO NO NO SI NO NO NO NO NO
30 DAVID M NO NO NO NO NO NO NO NO NO NO NO NO
40 MARÍA ELENA M NO NO NO NO NO NO SI SI NO NO NO NO
50 ALBERTO M NO NO NO NO NO NO SI NO NO NO NO NO
60 ROSA MARÍA F NO NO NO NO NO SI NO SI NO NO NO NO
70 GABRIEL M SI NO SI NO NO SI NO NO NO NO NO NO
80 MARÍA LUISA F SI NO NO NO NO NO NO NO NO NO NO NO
90 ARACELI M NO NO NO NO NO NO NO NO NO NO SI NO
100 GUSTAVO M NO NO NO NO NO NO NO SI NO NO NO NO
  • Con el conjunto de datos alumnos, hay que encontrar a 40 alumnos, ¿A cuáles?, bajo el muetreo sistematizado
N <- nrow(alumnos)
n = 100
saltos <- round(N / n, 0)
inicio <- round(sample(N, 1) / n, 0)

cuales <- seq(from = inicio, to =N, by= saltos)

kable(alumnos[cuales, ], caption = "La muestra de alumnos")
La muestra de alumnos
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera
20190057 57 9 226 4 89.10 SISTEMAS
20190116 116 7 165 34 93.67 SISTEMAS
20190175 175 3 50 33 90.91 SISTEMAS
20190234 234 7 105 22 84.00 SISTEMAS
20190293 293 4 83 33 86.28 SISTEMAS
20190352 352 8 176 32 80.47 SISTEMAS
20190411 411 7 165 34 82.78 SISTEMAS
20190470 470 9 198 29 83.33 ARQUITECTURA
20190529 529 10 172 12 79.97 ARQUITECTURA
20190588 588 4 80 30 90.28 ARQUITECTURA
20190647 647 6 124 26 83.85 ARQUITECTURA
20190706 706 1 NA 26 0.00 ARQUITECTURA
20190765 765 1 NA 26 0.00 ARQUITECTURA
20190824 824 6 132 30 82.96 ARQUITECTURA
20190883 883 6 91 30 85.53 ARQUITECTURA
20190942 942 5 88 30 83.32 ARQUITECTURA
20191001 1001 3 52 24 90.50 ARQUITECTURA
20191060 1060 1 NA 26 0.00 ARQUITECTURA
20191119 1119 1 NA 26 0.00 ARQUITECTURA
20191178 1178 9 140 23 82.81 BIOQUIMICA
20191237 1237 5 79 31 81.78 BIOQUIMICA
20191296 1296 8 95 28 76.81 BIOQUIMICA
20191355 1355 1 NA 23 0.00 BIOQUIMICA
20191414 1414 1 NA 23 0.00 BIOQUIMICA
20191473 1473 2 18 29 82.60 BIOQUIMICA
20191532 1532 3 47 25 87.09 BIOQUIMICA
20191591 1591 10 225 15 80.28 CIVIL
20191650 1650 9 235 10 91.00 CIVIL
20191709 1709 5 67 8 82.71 CIVIL
20191768 1768 6 139 30 85.21 CIVIL
20191827 1827 1 NA 27 0.00 CIVIL
20191886 1886 4 51 31 78.83 CIVIL
20191945 1945 3 55 30 87.33 CIVIL
20192004 2004 4 78 18 81.06 CIVIL
20192063 2063 5 121 31 87.12 CIVIL
20192122 2122 2 27 26 80.17 CIVIL
20192181 2181 1 NA 27 0.00 CIVIL
20192240 2240 9 221 14 92.94 ELECTRICA
20192299 2299 7 160 31 88.08 ELECTRICA
20192358 2358 7 98 9 81.04 ELECTRICA
20192417 2417 3 56 26 92.00 ELECTRICA
20192476 2476 3 51 28 85.92 ELECTRICA
20192535 2535 6 104 24 82.96 ELECTRONICA
20192594 2594 1 NA 25 0.00 ELECTRONICA
20192653 2653 5 105 28 95.17 ELECTRONICA
20192712 2712 11 235 10 80.68 INDUSTRIAL
20192771 2771 4 75 32 80.59 INDUSTRIAL
20192830 2830 8 174 36 81.22 INDUSTRIAL
20192889 2889 5 112 30 90.72 INDUSTRIAL
20192948 2948 6 120 26 79.30 INDUSTRIAL
20193007 3007 6 142 25 83.56 INDUSTRIAL
20193066 3066 7 149 25 87.74 INDUSTRIAL
20193125 3125 3 55 27 84.08 INDUSTRIAL
20193184 3184 6 139 28 84.48 INDUSTRIAL
20193243 3243 3 51 29 86.83 INDUSTRIAL
20193302 3302 5 95 27 81.18 INDUSTRIAL
20193361 3361 5 87 31 84.70 INDUSTRIAL
20193420 3420 7 132 27 83.52 MECANICA
20193479 3479 7 142 35 80.45 MECANICA
20193538 3538 5 108 29 84.88 MECANICA
20193597 3597 5 103 34 81.17 MECANICA
20193656 3656 6 113 29 79.72 MECANICA
20193715 3715 10 178 8 79.81 MECATRONICA
20193774 3774 7 159 30 87.76 MECATRONICA
20193833 3833 7 151 31 82.44 MECATRONICA
20193892 3892 6 76 20 81.18 MECATRONICA
20193951 3951 6 47 4 82.09 MECATRONICA
20194010 4010 1 NA 25 0.00 MECATRONICA
20194069 4069 5 105 24 86.74 MECATRONICA
20194128 4128 11 161 32 81.21 QUIMICA
20194187 4187 5 109 25 87.22 QUIMICA
20194246 4246 9 230 5 85.70 QUIMICA
20194305 4305 2 11 25 91.67 QUIMICA
20194364 4364 4 86 28 88.50 QUIMICA
20194423 4423 9 215 20 83.36 QUIMICA
20194482 4482 2 25 30 82.00 QUIMICA
20194541 4541 5 88 29 84.84 QUIMICA
20194600 4600 9 204 20 82.31 QUIMICA
20194659 4659 7 162 30 88.71 QUIMICA
20194718 4718 10 225 10 85.17 GESTION EMPRESARIAL
20194777 4777 5 107 33 87.87 GESTION EMPRESARIAL
20194836 4836 1 NA 27 0.00 GESTION EMPRESARIAL
20194895 4895 3 53 29 87.92 GESTION EMPRESARIAL
20194954 4954 2 22 26 91.20 GESTION EMPRESARIAL
20195013 5013 2 27 27 84.50 GESTION EMPRESARIAL
20195072 5072 3 54 28 93.08 GESTION EMPRESARIAL
20195131 5131 3 54 28 90.75 GESTION EMPRESARIAL
20195190 5190 3 45 33 85.10 GESTION EMPRESARIAL
20195249 5249 2 22 27 92.40 GESTION EMPRESARIAL
20195308 5308 1 NA 26 0.00 TIC
20195367 5367 7 85 18 82.58 INFORMATICA
20195426 5426 7 156 33 90.29 INFORMATICA
20195485 5485 9 262 10 92.09 ADMINISTRACION
20195544 5544 5 89 28 85.63 ADMINISTRACION
20195603 5603 1 NA 27 0.00 ADMINISTRACION
20195662 5662 1 NA 27 0.00 ADMINISTRACION
20195721 5721 8 180 34 85.00 ADMINISTRACION
20195780 5780 4 84 33 89.94 ADMINISTRACION
20195839 5839 6 140 28 91.93 ADMINISTRACION
20195898 5898 2 23 28 87.80 ADMINISTRACION

3.3: Muestreo aleatorio estratificado

N <- nrow(personas)
n <- 10
femeninos <- filter(personas, generos=='F')
masculinos <- filter(personas, generos=='M')

frfem <- nrow(femeninos) / N
frmas <- nrow(masculinos) / N

frfem
## [1] 0.42
frmas
## [1] 0.58
muestraFem <- sample(femeninos, n * frfem)
kable(muestraFem, caption = "La muestra de personas Femenino")
La muestra de personas Femenino
nombres generos ajedrez beisbol tiro.arco pesas futbol softbol atletismo folklorico tahitiano teatro rondalla pantomima orig.id
2 GUADALUPE F NO NO NO NO NO NO NO NO NO NO NO NO 2
15 TERESA F NO NO NO NO NO NO NO SI NO NO NO NO 15
14 FRANCISCA F NO NO SI NO NO NO SI NO NO NO NO NO 14
7 JAVIER F NO NO NO NO NO SI NO NO NO NO SI NO 7 
muestraMas <- sample(masculinos, n * frmas)
kable(muestraMas, caption = "La muestra de personas Masculino")
La muestra de personas Masculino
nombres generos ajedrez beisbol tiro.arco pesas futbol softbol atletismo folklorico tahitiano teatro rondalla pantomima orig.id
30 MARIO M NO NO SI SI NO NO NO NO NO NO NO NO 30
52 JOSÉ GUADALUPE M NO NO NO NO NO SI NO NO NO NO NO SI 52
7 MIGUEL ÁNGEL M NO NO NO NO NO NO NO NO SI NO NO NO 7
58 GUSTAVO M NO NO NO NO NO NO NO SI NO NO NO NO 58
34 LUIS M NO NO NO NO NO NO NO NO SI NO NO SI 34 
N <- nrow(alumnos)
n <- 100

tabla_frec <- data.frame(fdt_cat(alumnos$Carrera))

tabla_frec$muestra <-  round(tabla_frec$rf * n, 0)

kable(tabla_frec, caption = "Tabla de frecuencia de alumnos")
Tabla de frecuencia de alumnos
Category f rf rf… cf cf… muestra
INDUSTRIAL 707 0.1192444 11.924439 707 11.92444 12
ARQUITECTURA 675 0.1138472 11.384719 1382 23.30916 11
CIVIL 648 0.1092933 10.929330 2030 34.23849 11
GESTION EMPRESARIAL 585 0.0986676 9.866757 2615 44.10525 10
QUIMICA 568 0.0958003 9.580030 3183 53.68528 10
ADMINISTRACION 497 0.0838253 8.382527 3680 62.06780 8
SISTEMAS 452 0.0762355 7.623545 4132 69.69135 8
BIOQUIMICA 441 0.0743802 7.438016 4573 77.12936 7
MECATRONICA 432 0.0728622 7.286220 5005 84.41558 7
MECANICA 301 0.0507674 5.076741 5306 89.49233 5
ELECTRICA 280 0.0472255 4.722550 5586 94.21488 5
ELECTRONICA 161 0.0271547 2.715466 5747 96.93034 3
INFORMATICA 101 0.0170349 1.703491 5848 98.63383 2
TIC 81 0.0136617 1.366166 5929 100.00000 1 
N <- nrow(alumnos)
n <- 100
sistemas  <- filter(alumnos, Carrera =='SISTEMAS')
civil <- filter(alumnos, Carrera == 'CIVIL')


frsistemas <- nrow(sistemas) / N
frcivil <- nrow(civil) / N

frsistemas
## [1] 0.07623545
frcivil
## [1] 0.1092933
muestrasistemas <- sample(sistemas, round(n * frsistemas, 0))
kable(muestrasistemas, caption = "La muestra de alumnos de Sistemas")
La muestra de alumnos de Sistemas
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera orig.id
20190279 279 8 177 31 88.82 SISTEMAS 279
20190127 127 4 68 34 80.53 SISTEMAS 127
20190048 48 9 212 4 91.28 SISTEMAS 48
20190104 104 3 50 33 86.55 SISTEMAS 104
20190452 452 2 27 28 84.50 SISTEMAS 452
20190226 226 6 128 32 83.18 SISTEMAS 226
20190184 184 5 116 26 92.64 SISTEMAS 184
20190356 356 3 55 28 91.67 SISTEMAS 356 
muestracivil <- sample(civil, round(n * frcivil, 0))
kable(muestracivil, caption = "La muestra de alumnos de Civil")
La muestra de alumnos de Civil
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera orig.id
20191740 1740 5 113 30 88.63 CIVIL 172
20192009 2009 4 82 31 82.71 CIVIL 441
20191578 1578 10 205 25 81.95 CIVIL 10
20191905 1905 7 154 32 82.64 CIVIL 337
20191984 1984 6 133 30 86.79 CIVIL 416
20191731 1731 8 187 25 86.03 CIVIL 163
20191798 1798 6 116 34 84.04 CIVIL 230
20191829 1829 6 97 28 79.57 CIVIL 261
20192158 2158 2 27 30 93.17 CIVIL 590
20192056 2056 8 172 21 88.53 CIVIL 488
20191587 1587 10 216 14 78.87 CIVIL 19

3.4: Muestreo por conglomerados

#Primero cargar datos de localidades de Durango.
N <- nrow(alumnos)
n <- 100

locdurangomx <- read.csv("https://raw.githubusercontent.com/rpizarrog/probabilidad-y-estad-stica/master/datos/locdurangomx.csv", encoding = "UTF-8")



# Segundo por medio de función sample() generar cinco registros aleatorios de localidades y agregar un sexto registro de Victoria de Durango.
set.seed(1000)
localidades6 <- locdurangomx[sample(nrow(locdurangomx), 5), ]

localidades6 <- rbind(localidades6, locdurangomx[1,])



# Tercero agregar las columnas con el nombre de localidad, latitud y longitud al conjunto de datos alumnos.
registros <- locdurangomx[sample(localidades6$X, N, replace = TRUE, prob = c(.10, 0.12, 0.05, 0.07, 0.06, 0.60)),c("Nom_Loc", "Lat_Decimal", "Lon_Decimal")]

alumnos$localidad <- registros$Nom_Loc
alumnos$latitud <- registros$Lat_Decimal
alumnos$longitud <- registros$Lon_Decimal

kable(head(alumnos, 10), caption = "Los primeros diez registros de alumnos")
Los primeros diez registros de alumnos
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera localidad latitud longitud
20190001 1 11 198 19 80.21 SISTEMAS Las Aves 23.94883 -104.5715
20190002 2 11 235 10 84.33 SISTEMAS Victoria de Durango 24.02399 -104.6702
20190003 3 9 235 10 95.25 SISTEMAS Victoria de Durango 24.02399 -104.6702
20190004 4 9 226 19 95.00 SISTEMAS Victoria de Durango 24.02399 -104.6702
20190005 5 10 231 14 82.32 SISTEMAS Victoria de Durango 24.02399 -104.6702
20190006 6 9 212 23 95.02 SISTEMAS Las Aves 23.94883 -104.5715
20190007 7 12 221 10 79.06 SISTEMAS Victoria de Durango 24.02399 -104.6702
20190008 8 9 226 9 92.47 SISTEMAS Los Fresnos 24.08339 -104.6095
20190009 9 9 231 4 91.08 SISTEMAS Las Aves 23.94883 -104.5715
20190010 10 11 222 13 80.42 SISTEMAS Victoria de Durango 24.02399 -104.6702 
kable(tail(alumnos, 10), caption = "Las útimos diez registros de alumnos")
Las útimos diez registros de alumnos
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera localidad latitud longitud
20195920 5920 7 169 23 89.14 ADMINISTRACION Victoria de Durango 24.02399 -104.6702
20195921 5921 5 109 26 87.83 ADMINISTRACION Los Fresnos 24.08339 -104.6095
20195922 5922 3 55 29 92.83 ADMINISTRACION Victoria de Durango 24.02399 -104.6702
20195923 5923 2 23 23 88.60 ADMINISTRACION Michel [Granja] 24.00545 -104.7152
20195924 5924 2 27 28 92.83 ADMINISTRACION Las Brisas 23.97352 -104.5800
20195925 5925 7 94 13 80.95 ADMINISTRACION Victoria de Durango 24.02399 -104.6702
20195926 5926 5 103 32 92.68 ADMINISTRACION Las Aves 23.94883 -104.5715
20195927 5927 4 79 34 86.18 ADMINISTRACION Victoria de Durango 24.02399 -104.6702
20195928 5928 5 108 32 90.48 ADMINISTRACION Victoria de Durango 24.02399 -104.6702
20195929 5929 7 169 32 92.33 ADMINISTRACION Microondas el Tecolote 24.05248 -104.8519 
# Cuarto encontrar frecuencias por localidad.
N <- nrow(alumnos)
n <- 100

tabla_frec <- data.frame(fdt_cat(alumnos$localidad))

tabla_frec$muestra <-  round(tabla_frec$rf * n, 0)

kable(tabla_frec, caption = "Tabla de frecuencia de alumnos por localidad")
Tabla de frecuencia de alumnos por localidad
Category f rf rf… cf cf… muestra
Victoria de Durango 3564 0.6011132 60.111317 3564 60.11132 60
Las Brisas 691 0.1165458 11.654579 4255 71.76590 12
Las Aves 626 0.1055827 10.558273 4881 82.32417 11
Los Fresnos 431 0.0726935 7.269354 5312 89.59352 7
Microondas el Tecolote 329 0.0554900 5.548997 5641 95.14252 6
Michel [Granja] 288 0.0485748 4.857480 5929 100.00000 5 
# Quinto determinar el porcentaje que le corresponde a cada conglomerado conforme a la frecuencia relativa.
N <- nrow(alumnos)
n <- 100

loc1 <- filter(alumnos, localidad == tabla_frec$Category[1])
loc2 <- filter(alumnos, localidad == tabla_frec$Category[2])
loc3 <- filter(alumnos, localidad == tabla_frec$Category[3])
loc4 <- filter(alumnos, localidad == tabla_frec$Category[4])
loc5 <- filter(alumnos, localidad == tabla_frec$Category[5])
loc6 <- filter(alumnos, localidad == tabla_frec$Category[6])



frloc1 <- nrow(loc1) / N
frloc2 <- nrow(loc2) / N
frloc3 <- nrow(loc3) / N
frloc4 <- nrow(loc4) / N
frloc5 <- nrow(loc5) / N
frloc6 <- nrow(loc6) / N

muestraloc1 <- sample(loc1, round(n * frloc1, 0))
kable(muestraloc1, caption = paste("La muestra de alumnos de Localidad ",tabla_frec$Category[1] ))
La muestra de alumnos de Localidad Victoria de Durango
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera localidad latitud longitud orig.id
20195752 5752 3 55 29 95.67 ADMINISTRACION Victoria de Durango 24.02399 -104.6702 3462
20191354 1354 7 167 34 86.40 BIOQUIMICA Victoria de Durango 24.02399 -104.6702 809
20195197 5197 8 195 25 87.88 GESTION EMPRESARIAL Victoria de Durango 24.02399 -104.6702 3142
20194694 4694 9 230 15 92.17 GESTION EMPRESARIAL Victoria de Durango 24.02399 -104.6702 2835
20191656 1656 12 179 33 77.27 CIVIL Victoria de Durango 24.02399 -104.6702 995
20193520 3520 1 NA 26 0.00 MECANICA Victoria de Durango 24.02399 -104.6702 2155
20191220 1220 5 81 34 85.44 BIOQUIMICA Victoria de Durango 24.02399 -104.6702 728
20191366 1366 2 23 29 90.17 BIOQUIMICA Victoria de Durango 24.02399 -104.6702 818
20190579 579 4 80 30 89.11 ARQUITECTURA Victoria de Durango 24.02399 -104.6702 331
20192440 2440 1 NA 24 0.00 ELECTRICA Victoria de Durango 24.02399 -104.6702 1484
20195184 5184 3 60 29 84.85 GESTION EMPRESARIAL Victoria de Durango 24.02399 -104.6702 3132
20191337 1337 8 186 24 84.36 BIOQUIMICA Victoria de Durango 24.02399 -104.6702 798
20190945 945 6 134 24 87.86 ARQUITECTURA Victoria de Durango 24.02399 -104.6702 563
20194561 4561 1 NA 25 0.00 QUIMICA Victoria de Durango 24.02399 -104.6702 2751
20190949 949 2 26 26 87.67 ARQUITECTURA Victoria de Durango 24.02399 -104.6702 565
20190853 853 2 24 22 87.00 ARQUITECTURA Victoria de Durango 24.02399 -104.6702 511
20194009 4009 2 25 28 80.67 MECATRONICA Victoria de Durango 24.02399 -104.6702 2423
20190981 981 5 110 32 89.50 ARQUITECTURA Victoria de Durango 24.02399 -104.6702 587
20193423 3423 7 102 30 80.91 MECANICA Victoria de Durango 24.02399 -104.6702 2093
20195597 5597 8 207 27 93.09 ADMINISTRACION Victoria de Durango 24.02399 -104.6702 3369
20192461 2461 7 150 28 82.79 ELECTRICA Victoria de Durango 24.02399 -104.6702 1496
20191351 1351 3 52 30 85.75 BIOQUIMICA Victoria de Durango 24.02399 -104.6702 807
20190343 343 8 165 28 81.31 SISTEMAS Victoria de Durango 24.02399 -104.6702 201
20194890 4890 7 170 35 87.44 GESTION EMPRESARIAL Victoria de Durango 24.02399 -104.6702 2947
20191348 1348 7 164 32 91.03 BIOQUIMICA Victoria de Durango 24.02399 -104.6702 806
20190739 739 1 NA 26 0.00 ARQUITECTURA Victoria de Durango 24.02399 -104.6702 433
20191212 1212 7 165 36 86.37 BIOQUIMICA Victoria de Durango 24.02399 -104.6702 723
20193020 3020 3 55 29 92.15 INDUSTRIAL Victoria de Durango 24.02399 -104.6702 1848
20191394 1394 2 23 29 86.83 BIOQUIMICA Victoria de Durango 24.02399 -104.6702 836
20194023 4023 1 NA 25 0.00 MECATRONICA Victoria de Durango 24.02399 -104.6702 2434
20192358 2358 7 98 9 81.04 ELECTRICA Victoria de Durango 24.02399 -104.6702 1435
20194165 4165 4 53 20 77.91 QUIMICA Victoria de Durango 24.02399 -104.6702 2522
20194937 4937 7 167 33 88.00 GESTION EMPRESARIAL Victoria de Durango 24.02399 -104.6702 2978
20192500 2500 9 197 20 84.05 ELECTRONICA Victoria de Durango 24.02399 -104.6702 1518
20190866 866 6 142 28 88.53 ARQUITECTURA Victoria de Durango 24.02399 -104.6702 518
20190307 307 2 27 28 77.00 SISTEMAS Victoria de Durango 24.02399 -104.6702 180
20195480 5480 9 228 24 86.23 ADMINISTRACION Victoria de Durango 24.02399 -104.6702 3304
20195413 5413 1 NA 27 0.00 INFORMATICA Victoria de Durango 24.02399 -104.6702 3267
20195861 5861 7 169 32 93.89 ADMINISTRACION Victoria de Durango 24.02399 -104.6702 3521
20190661 661 3 52 28 83.42 ARQUITECTURA Victoria de Durango 24.02399 -104.6702 384
20191654 1654 10 171 32 78.42 CIVIL Victoria de Durango 24.02399 -104.6702 994
20194474 4474 8 205 20 83.76 QUIMICA Victoria de Durango 24.02399 -104.6702 2699
20194055 4055 3 43 14 81.10 MECATRONICA Victoria de Durango 24.02399 -104.6702 2453
20190746 746 4 76 28 89.29 ARQUITECTURA Victoria de Durango 24.02399 -104.6702 436
20193336 3336 7 179 26 89.12 INDUSTRIAL Victoria de Durango 24.02399 -104.6702 2038
20195409 5409 3 55 27 87.92 INFORMATICA Victoria de Durango 24.02399 -104.6702 3266
20195033 5033 3 50 28 94.45 GESTION EMPRESARIAL Victoria de Durango 24.02399 -104.6702 3034
20190549 549 9 218 17 88.69 ARQUITECTURA Victoria de Durango 24.02399 -104.6702 313
20192620 2620 3 47 23 86.91 ELECTRONICA Victoria de Durango 24.02399 -104.6702 1591
20190186 186 3 41 28 83.89 SISTEMAS Victoria de Durango 24.02399 -104.6702 110
20191297 1297 3 52 30 87.00 BIOQUIMICA Victoria de Durango 24.02399 -104.6702 775
20193034 3034 5 85 31 88.21 INDUSTRIAL Victoria de Durango 24.02399 -104.6702 1858
20194007 4007 7 115 27 82.96 MECATRONICA Victoria de Durango 24.02399 -104.6702 2421
20195690 5690 4 79 29 88.53 ADMINISTRACION Victoria de Durango 24.02399 -104.6702 3421
20194231 4231 7 172 32 88.94 QUIMICA Victoria de Durango 24.02399 -104.6702 2561
20193544 3544 3 48 27 82.82 MECANICA Victoria de Durango 24.02399 -104.6702 2165
20192218 2218 11 235 10 84.19 ELECTRICA Victoria de Durango 24.02399 -104.6702 1345
20195545 5545 7 145 29 85.77 ADMINISTRACION Victoria de Durango 24.02399 -104.6702 3341
20194135 4135 7 172 26 85.39 QUIMICA Victoria de Durango 24.02399 -104.6702 2500
20193613 3613 3 52 24 85.50 MECANICA Victoria de Durango 24.02399 -104.6702 2207 
muestraloc2 <- sample(loc2, round(n * frloc2, 0))
kable(muestraloc2, caption = paste("La muestra de alumnos de Localidad ",tabla_frec$Category[2] ))
La muestra de alumnos de Localidad Las Brisas
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera localidad latitud longitud orig.id
20192268 2268 10 216 14 83.80 ELECTRICA Las Brisas 23.97352 -104.58 262
20195323 5323 1 NA 26 0.00 TIC Las Brisas 23.97352 -104.58 631
20192994 2994 7 172 33 86.44 INDUSTRIAL Las Brisas 23.97352 -104.58 344
20194348 4348 5 114 30 89.92 QUIMICA Las Brisas 23.97352 -104.58 515
20193182 3182 2 27 24 83.00 INDUSTRIAL Las Brisas 23.97352 -104.58 375
20192346 2346 5 99 28 84.35 ELECTRICA Las Brisas 23.97352 -104.58 271
20192814 2814 7 163 35 84.35 INDUSTRIAL Las Brisas 23.97352 -104.58 326
20195766 5766 1 NA 27 0.00 ADMINISTRACION Las Brisas 23.97352 -104.58 678
20192753 2753 6 158 26 88.00 INDUSTRIAL Las Brisas 23.97352 -104.58 321
20194882 4882 3 32 31 84.43 GESTION EMPRESARIAL Las Brisas 23.97352 -104.58 577
20193378 3378 10 225 10 82.12 MECANICA Las Brisas 23.97352 -104.58 391
20191305 1305 1 NA 23 0.00 BIOQUIMICA Las Brisas 23.97352 -104.58 161 
muestraloc3 <- sample(loc3, round(n * frloc3, 0))
kable(muestraloc3, caption = paste("La muestra de alumnos de Localidad ",tabla_frec$Category[3] ))
La muestra de alumnos de Localidad Las Aves
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera localidad latitud longitud orig.id
20193085 3085 5 NA 26 0.00 INDUSTRIAL Las Aves 23.94883 -104.5715 320
20190244 244 5 112 25 87.54 SISTEMAS Las Aves 23.94883 -104.5715 23
20191061 1061 8 168 32 82.86 ARQUITECTURA Las Aves 23.94883 -104.5715 121
20190039 39 9 222 13 92.21 SISTEMAS Las Aves 23.94883 -104.5715 6
20194015 4015 4 62 26 85.00 MECATRONICA Las Aves 23.94883 -104.5715 439
20191448 1448 7 174 27 87.08 BIOQUIMICA Las Aves 23.94883 -104.5715 165
20194301 4301 6 129 26 84.96 QUIMICA Las Aves 23.94883 -104.5715 462
20190390 390 5 107 30 80.26 SISTEMAS Las Aves 23.94883 -104.5715 41
20193641 3641 5 57 23 78.85 MECANICA Las Aves 23.94883 -104.5715 387
20193522 3522 1 NA 26 0.00 MECANICA Las Aves 23.94883 -104.5715 366
20190306 306 4 87 33 93.26 SISTEMAS Las Aves 23.94883 -104.5715 34 
muestraloc4 <- sample(loc4, round(n * frloc4, 0))
kable(muestraloc4, caption = paste("La muestra de alumnos de Localidad ",tabla_frec$Category[4] ))
La muestra de alumnos de Localidad Los Fresnos
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera localidad latitud longitud orig.id
20194732 4732 12 225 10 86.83 GESTION EMPRESARIAL Los Fresnos 24.08339 -104.6095 310
20194974 4974 8 205 30 88.56 GESTION EMPRESARIAL Los Fresnos 24.08339 -104.6095 332
20195248 5248 1 NA 27 0.00 GESTION EMPRESARIAL Los Fresnos 24.08339 -104.6095 356
20194853 4853 2 32 27 94.57 GESTION EMPRESARIAL Los Fresnos 24.08339 -104.6095 325
20192243 2243 10 226 9 82.25 ELECTRICA Los Fresnos 24.08339 -104.6095 154
20195503 5503 10 262 10 93.87 ADMINISTRACION Los Fresnos 24.08339 -104.6095 388
20191152 1152 11 108 17 78.00 BIOQUIMICA Los Fresnos 24.08339 -104.6095 72 
muestraloc5 <- sample(loc5, round(n * frloc5, 0))
kable(muestraloc5, caption = paste("La muestra de alumnos de Localidad ",tabla_frec$Category[5] ))
La muestra de alumnos de Localidad Microondas el Tecolote
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera localidad latitud longitud orig.id
20192935 2935 5 104 34 86.39 INDUSTRIAL Microondas el Tecolote 24.05248 -104.8519 168
20192340 2340 1 NA 24 0.00 ELECTRICA Microondas el Tecolote 24.05248 -104.8519 133
20191209 1209 5 104 30 82.91 BIOQUIMICA Microondas el Tecolote 24.05248 -104.8519 62
20190236 236 1 NA 27 0.00 SISTEMAS Microondas el Tecolote 24.05248 -104.8519 15
20195268 5268 5 101 28 82.55 TIC Microondas el Tecolote 24.05248 -104.8519 294
20192138 2138 5 99 33 84.43 CIVIL Microondas el Tecolote 24.05248 -104.8519 116 
muestraloc6 <- sample(loc6, round(n * frloc6, 0))
kable(muestraloc6, caption = paste("La muestra de alumnos de Localidad ",tabla_frec$Category[6] ))
La muestra de alumnos de Localidad Michel [Granja]
No. Control Alumno Semestre Cr. Apr. Carga Promedio Carrera localidad latitud longitud orig.id
20193554 3554 3 52 31 86.33 MECANICA Michel [Granja] 24.00545 -104.7152 175
20194555 4555 6 133 23 83.14 QUIMICA Michel [Granja] 24.00545 -104.7152 223
20192499 2499 11 205 15 79.93 ELECTRONICA Michel [Granja] 24.00545 -104.7152 119
20192495 2495 3 51 28 92.50 ELECTRICA Michel [Granja] 24.00545 -104.7152 118
20192977 2977 8 201 28 83.67 INDUSTRIAL Michel [Granja] 24.00545 -104.7152 143
  • Usando los valores de latitud y longitud
map<-leaflet() %>%
  addTiles() %>%
  addMarkers(lat=localidades6$Lat_Decimal[1],lng=localidades6$Lon_Decimal[1] ,popup=localidades6$Nom_Loc[1]) %>%
   addMarkers(lat=localidades6$Lat_Decimal[2],lng=localidades6$Lon_Decimal[2] ,popup=localidades6$Nom_Loc[2]) %>%
   addMarkers(lat=localidades6$Lat_Decimal[3],lng=localidades6$Lon_Decimal[3] ,popup=localidades6$Nom_Loc[3]) %>%
   addMarkers(lat=localidades6$Lat_Decimal[4],lng=localidades6$Lon_Decimal[4] ,popup=localidades6$Nom_Loc[4]) %>%
   addMarkers  (lat=localidades6$Lat_Decimal[5],lng=localidades6$Lon_Decimal[5] ,popup=localidades6$Nom_Loc[5]) %>%
   addMarkers  (lat=localidades6$Lat_Decimal[6],lng=localidades6$Lon_Decimal[6] ,popup=localidades6$Nom_Loc[6])
# Mostrar el mapa 
map

Paso 4: Interpretacion del caso

En este caso se vieron los algunos tipos de muestreos, el muestreo aleatorio simple y muestra aleatorio estratificado, los cuales ayudan a sacar resultados de muestras aleatorias, por ejemplo:

  • En el muestreo aleatorio simple, es hacer una simulacion con los registros captados de los alumnos para saber que alumnos salen en estos datos, se pide que se entrevisten a 30 personas de los 40 alumnos registrados, de los cuales se les pido los siguientes datos (los datos son falsos, no son verdaderos todos los datos que estan en este caso): No. de control, Num. de alumno, en que semestre va, Creditos aprobados, Carga academica, Promedio y Carrera.

  • En el muestreo aleatorio estratificado, en este muestreo se separa por carrera con unos cuantos alumnos determinados y se pide encontrar algunas frecuencias y muestran que se pueden obtener en las diferentes carreras que ofrece el instituto, en la tabla de frecuencia se muestra la cantidad de alumnos que cursan esa carrera, un porcentaje de alumnos que va bien en sus promedios y muestras, las cuales indican que alumnos van bien en sus carreras.

  • En el muestreo por conglomerados, este funciona diferente, ya que este se enfoca en las localidades, atidtud y longitud, de los alumnos, con la finalidad de sacar sus frecuencias y muestras, esto permite saber de donde son algunos alumnos.