Muestreo y tipos de muestreo

Objetivo

Determinar y simular muestreos

Descripción

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.

1. Cargar librerías

library(dplyr)
library(mosaic)

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

library(readr)
library(ggplot2)  # Para gráficos
library(knitr)    # Para formateo de datos
library(fdth)     # Para tablas de frecuencias

2. Cargar datos

2.1. Cargar datos de nombres de personas

• Se carga un conjunto de 100 nombres de personas con sus atributo de género y la actividad deportiva o cultura que practican,
• Cargando un datos llamando a una función que construye los datos.
• El argumento encoding significa que acepte acentos en los 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 = "Los primeros diez registros de nombres en el conjunto dedatos")

Los primeros diez registros de nombres en el conjunto dedatos

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 = "Las útimos diez registros de nombres en el conjunto de datos")

Las útimos diez registros de nombres en el conjunto de datos

	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.2. Cargar datos de alumnos

Se cargan os datos de alumnos inscritos en una Institución de educación superior en el semetre septiembre 2020 a enero 2021, con los atributos siguientes: - 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")

## Parsed with column specification:
## cols(
##   `No. Control` = col_double(),
##   Alumno = col_double(),
##   Semestre = col_double(),
##   `Cr. Apr.` = col_double(),
##   Carga = col_double(),
##   Promedio = col_double(),
##   Carrera = col_character()
## )

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
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 = "Las útimos diez registros de alumnos")

Las útimos diez registros de 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

3. Simular muestreos

3.1 Muestreo aleatorio simple

Hay que encuestar a diez personas de 100 para hacerles alguna entrevist, ¿a quienes? Con el conjunto de datos seleccionar 10 personas aleatoriamente con al funcón sample()

N <- nrow(personas)
n <- 10
muestra <- sample(personas$nombres, n)
kable(muestra, caption = "La muestra de personas")

La muestra de personas

x
DANIEL
JUAN MANUEL
MIGUEL
GUSTAVO
FRANCISCA
RAÚL
JUAN
LUCÍA
MARÍA TERESA
JORGE

Encontrar 100 alumnos

N <- nrow(alumnos)
n <- 100
muestra <- sample(N, n) # Genera los números
kable(alumnos[muestra, ], caption = "La muestra de alumnos")

La muestra de alumnos

No. Control	Alumno	Semestre	Cr. Apr.	Carga	Promedio	Carrera
20192700	2700	9	202	19	82.26	INDUSTRIAL
20191164	1164	9	129	18	83.79	BIOQUIMICA
20191469	1469	7	150	36	80.81	BIOQUIMICA
20195645	5645	3	55	29	97.67	ADMINISTRACION
20193227	3227	7	163	30	86.30	INDUSTRIAL
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
20195920	5920	7	169	23	89.14	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

3.2. Muestreo aleatorio sistemático

Con el conjunto de datos personas, iniciar en un valor aletorio e identificar los siguientes de 10 en 10 hasta tener diez personas.

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
6	GUADALUPE	F	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO
16	MARÍA DEL CARMEN	F	NO	NO	NO	NO	NO	SI	NO	NO	NO	NO	NO	NO
26	JAVIER	F	NO	NO	NO	NO	NO	SI	NO	NO	NO	NO	SI	NO
36	FRANCISCO JAVIER	F	SI	NO	NO	NO	NO	NO	NO	SI	NO	NO	SI	NO
46	TERESA	F	NO	NO	NO	NO	NO	NO	NO	SI	NO	NO	NO	NO
56	YOLANDA	F	SI	NO	NO	NO	SI	NO	NO	NO	NO	NO	NO	NO
66	VÍCTOR MANUEL	M	NO	SI	SI	SI	NO	NO	NO	NO	NO	NO	NO	NO
76	MARÍA ISABEL	F	NO	SI	NO	NO	NO	NO	NO	NO	NO	NO	NO	SI
86	JOSÉ GUADALUPE	M	NO	NO	NO	NO	NO	SI	NO	NO	NO	NO	NO	SI
96	LUCÍA	F	NO	SI	NO	SI	NO	NO	NO	SI	NO	NO	SI	SI

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
20190040	40	9	217	18	92.00	SISTEMAS
20190099	99	1	NA	27	0.00	SISTEMAS
20190158	158	1	NA	27	0.00	SISTEMAS
20190217	217	1	NA	27	0.00	SISTEMAS
20190276	276	3	8	22	80.00	SISTEMAS
20190335	335	3	50	28	92.00	SISTEMAS
20190394	394	3	50	28	88.55	SISTEMAS
20190453	453	9	219	16	89.98	ARQUITECTURA
20190512	512	9	223	4	90.24	ARQUITECTURA
20190571	571	1	NA	26	0.00	ARQUITECTURA
20190630	630	1	NA	26	0.00	ARQUITECTURA
20190689	689	1	NA	26	0.00	ARQUITECTURA
20190748	748	6	117	33	86.38	ARQUITECTURA
20190807	807	3	48	32	89.82	ARQUITECTURA
20190866	866	6	142	28	88.53	ARQUITECTURA
20190925	925	4	80	30	93.39	ARQUITECTURA
20190984	984	6	120	28	85.59	ARQUITECTURA
20191043	1043	2	26	26	88.33	ARQUITECTURA
20191102	1102	3	52	28	88.33	ARQUITECTURA
20191161	1161	9	247	11	90.62	BIOQUIMICA
20191220	1220	5	81	34	85.44	BIOQUIMICA
20191279	1279	3	52	30	97.92	BIOQUIMICA
20191338	1338	4	77	22	80.47	BIOQUIMICA
20191397	1397	4	77	28	85.71	BIOQUIMICA
20191456	1456	6	118	34	84.35	BIOQUIMICA
20191515	1515	5	99	26	86.86	BIOQUIMICA
20191574	1574	12	230	5	79.42	CIVIL
20191633	1633	11	206	29	79.65	CIVIL
20191692	1692	8	193	27	80.38	CIVIL
20191751	1751	7	175	24	87.25	CIVIL
20191810	1810	5	109	30	82.48	CIVIL
20191869	1869	3	57	24	90.83	CIVIL
20191928	1928	5	100	19	80.00	CIVIL
20191987	1987	5	101	28	83.71	CIVIL
20192046	2046	8	150	33	81.77	CIVIL
20192105	2105	8	178	30	79.41	CIVIL
20192164	2164	1	NA	27	0.00	CIVIL
20192223	2223	9	220	15	83.30	ELECTRICA
20192282	2282	5	94	26	84.09	ELECTRICA
20192341	2341	3	46	28	91.55	ELECTRICA
20192400	2400	1	NA	24	0.00	ELECTRICA
20192459	2459	1	NA	24	0.00	ELECTRICA
20192518	2518	11	192	23	83.88	ELECTRONICA
20192577	2577	3	52	25	87.67	ELECTRONICA
20192636	2636	5	105	28	92.65	ELECTRONICA
20192695	2695	9	226	4	85.18	INDUSTRIAL
20192754	2754	5	93	34	83.29	INDUSTRIAL
20192813	2813	5	98	32	83.41	INDUSTRIAL
20192872	2872	7	156	36	84.71	INDUSTRIAL
20192931	2931	2	27	24	82.83	INDUSTRIAL
20192990	2990	9	235	10	84.96	INDUSTRIAL
20193049	3049	2	27	24	81.50	INDUSTRIAL
20193108	3108	8	123	34	82.50	INDUSTRIAL
20193167	3167	2	27	28	88.33	INDUSTRIAL
20193226	3226	1	NA	27	0.00	INDUSTRIAL
20193285	3285	2	27	24	81.00	INDUSTRIAL
20193344	3344	5	55	27	86.69	INDUSTRIAL
20193403	3403	9	175	28	83.45	MECANICA
20193462	3462	7	83	30	78.05	MECANICA
20193521	3521	7	137	34	86.20	MECANICA
20193580	3580	8	175	21	85.34	MECANICA
20193639	3639	3	30	22	83.00	MECANICA
20193698	3698	9	219	16	89.63	MECATRONICA
20193757	3757	1	NA	25	0.00	MECATRONICA
20193816	3816	5	108	30	86.71	MECATRONICA
20193875	3875	4	67	23	79.07	MECATRONICA
20193934	3934	3	53	27	86.50	MECATRONICA
20193993	3993	8	151	27	79.53	MECATRONICA
20194052	4052	5	110	24	85.17	MECATRONICA
20194111	4111	9	224	6	91.26	QUIMICA
20194170	4170	10	211	24	80.44	QUIMICA
20194229	4229	3	36	30	89.25	QUIMICA
20194288	4288	13	235	10	78.98	QUIMICA
20194347	4347	7	138	24	85.07	QUIMICA
20194406	4406	4	86	28	81.44	QUIMICA
20194465	4465	9	214	21	89.05	QUIMICA
20194524	4524	10	127	13	78.89	QUIMICA
20194583	4583	7	150	22	86.16	QUIMICA
20194642	4642	2	25	31	89.17	QUIMICA
20194701	4701	9	230	5	94.75	GESTION EMPRESARIAL
20194760	4760	9	215	20	87.38	GESTION EMPRESARIAL
20194819	4819	3	54	28	87.08	GESTION EMPRESARIAL
20194878	4878	3	54	28	87.42	GESTION EMPRESARIAL
20194937	4937	7	167	33	88.00	GESTION EMPRESARIAL
20194996	4996	3	54	28	95.33	GESTION EMPRESARIAL
20195055	5055	1	NA	27	0.00	GESTION EMPRESARIAL
20195114	5114	7	185	25	95.74	GESTION EMPRESARIAL
20195173	5173	2	37	30	93.25	GESTION EMPRESARIAL
20195232	5232	3	54	28	89.08	GESTION EMPRESARIAL
20195291	5291	5	101	28	81.27	TIC
20195350	5350	9	215	16	84.57	INFORMATICA
20195409	5409	3	55	27	87.92	INFORMATICA
20195468	5468	11	240	22	84.88	ADMINISTRACION
20195527	5527	1	NA	27	0.00	ADMINISTRACION
20195586	5586	1	NA	27	0.00	ADMINISTRACION
20195645	5645	3	55	29	97.67	ADMINISTRACION
20195704	5704	5	79	29	86.06	ADMINISTRACION
20195763	5763	5	113	27	92.83	ADMINISTRACION
20195822	5822	5	113	27	95.63	ADMINISTRACION
20195881	5881	7	135	34	83.90	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
26	GABRIELA	F	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO	26
36	ISABEL	F	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO	36
39	CARMEN	F	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO	NO	39
10	FRANCISCO JAVIER	F	SI	NO	NO	NO	NO	NO	NO	SI	NO	NO	SI	NO	10

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
58	GUSTAVO	M	NO	NO	NO	NO	NO	NO	NO	SI	NO	NO	NO	NO	58
20	RAFAEL	M	NO	NO	NO	NO	NO	NO	NO	SI	NO	NO	NO	NO	20
3	JOSÉ	M	NO	SI	NO	SI	NO	NO	NO	NO	NO	NO	SI	SI	3
31	ALFREDO	M	NO	NO	NO	SI	NO	NO	NO	NO	NO	SI	NO	NO	31
47	RUBEN	M	NO	SI	NO	NO	NO	NO	NO	NO	NO	NO	SI	NO	47

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
20190046	46	9	221	14	90.71	SISTEMAS	46
20190130	130	4	87	33	87.89	SISTEMAS	130
20190335	335	3	50	28	92.00	SISTEMAS	335
20190142	142	3	36	23	89.13	SISTEMAS	142
20190199	199	1	NA	27	0.00	SISTEMAS	199
20190030	30	11	226	9	81.78	SISTEMAS	30
20190052	52	10	138	31	79.33	SISTEMAS	52
20190448	448	1	NA	27	0.00	SISTEMAS	448

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
20191982	1982	6	120	31	81.36	CIVIL	414
20191847	1847	5	122	30	86.00	CIVIL	279
20192207	2207	6	38	35	77.38	CIVIL	639
20192128	2128	6	118	34	78.44	CIVIL	560
20192184	2184	1	NA	27	0.00	CIVIL	616
20191794	1794	6	137	34	87.66	CIVIL	226
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

3.4. Muestreo por conglomerados

Al conjunto de datos alumnos agregar tres columnas.

N <- nrow(alumnos)
n <- 100

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

localidades50 <- locdurangomx[sample(nrow(locdurangomx), 5), ]

# localidades50

alumlocalidades <- sample(localidades50, N, replace = TRUE)

alumnos$localidad <- alumlocalidades$Nom_Loc
alumnos$latitud <- alumlocalidades$Lat_Decimal
alumnos$longitud <- alumlocalidades$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	Rancho el Bajío	24.22719	-104.7093
20190002	2	11	235	10	84.33	SISTEMAS	José Gamboa	24.07609	-104.5546
20190003	3	9	235	10	95.25	SISTEMAS	Rancho el Bajío	24.22719	-104.7093
20190004	4	9	226	19	95.00	SISTEMAS	Rancho el Bajío	24.22719	-104.7093
20190005	5	10	231	14	82.32	SISTEMAS	Rancho el Bajío	24.22719	-104.7093
20190006	6	9	212	23	95.02	SISTEMAS	Residencial Los Arcos [Fraccionamiento]	24.09682	-104.6913
20190007	7	12	221	10	79.06	SISTEMAS	Rancho el Bajío	24.22719	-104.7093
20190008	8	9	226	9	92.47	SISTEMAS	Rancho San Pablo	23.78263	-104.4304
20190009	9	9	231	4	91.08	SISTEMAS	Rancho San Pablo	23.78263	-104.4304
20190010	10	11	222	13	80.42	SISTEMAS	José Gamboa	24.07609	-104.5546

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	Residencial Los Arcos [Fraccionamiento]	24.09682	-104.6913
20195921	5921	5	109	26	87.83	ADMINISTRACION	Rancho el Bajío	24.22719	-104.7093
20195922	5922	3	55	29	92.83	ADMINISTRACION	José Gamboa	24.07609	-104.5546
20195923	5923	2	23	23	88.60	ADMINISTRACION	Tierra Prometida	24.00826	-104.5932
20195924	5924	2	27	28	92.83	ADMINISTRACION	José Gamboa	24.07609	-104.5546
20195925	5925	7	94	13	80.95	ADMINISTRACION	Rancho el Bajío	24.22719	-104.7093
20195926	5926	5	103	32	92.68	ADMINISTRACION	Residencial Los Arcos [Fraccionamiento]	24.09682	-104.6913
20195927	5927	4	79	34	86.18	ADMINISTRACION	Tierra Prometida	24.00826	-104.5932
20195928	5928	5	108	32	90.48	ADMINISTRACION	Residencial Los Arcos [Fraccionamiento]	24.09682	-104.6913
20195929	5929	7	169	32	92.33	ADMINISTRACION	Tierra Prometida	24.00826	-104.5932

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
José Gamboa	1216	0.2050936	20.50936	1216	20.50936	21
Tierra Prometida	1208	0.2037443	20.37443	2424	40.88379	20
Residencial Los Arcos [Fraccionamiento]	1180	0.1990218	19.90218	3604	60.78597	20
Rancho San Pablo	1174	0.1980098	19.80098	4778	80.58695	20
Rancho el Bajío	1151	0.1941305	19.41305	5929	100.00000	19

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



frloc1 <- nrow(loc1) / N
frloc2 <- nrow(loc2) / N
frloc3 <- nrow(loc3) / N
frloc4 <- nrow(loc4) / N
frloc5 <- nrow(loc5) / 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 José Gamboa

No. Control	Alumno	Semestre	Cr. Apr.	Carga	Promedio	Carrera	localidad	latitud	longitud	orig.id
20194278	4278	7	172	32	91.36	QUIMICA	José Gamboa	24.07609	-104.5546	891
20194700	4700	11	205	30	83.65	GESTION EMPRESARIAL	José Gamboa	24.07609	-104.5546	977
20193753	3753	6	109	36	90.46	MECATRONICA	José Gamboa	24.07609	-104.5546	774
20192092	2092	8	156	20	80.18	CIVIL	José Gamboa	24.07609	-104.5546	404
20191273	1273	4	82	31	85.94	BIOQUIMICA	José Gamboa	24.07609	-104.5546	249
20191508	1508	1	NA	23	0.00	BIOQUIMICA	José Gamboa	24.07609	-104.5546	292
20192338	2338	1	NA	24	0.00	ELECTRICA	José Gamboa	24.07609	-104.5546	454
20191070	1070	8	202	25	82.59	ARQUITECTURA	José Gamboa	24.07609	-104.5546	211
20193755	3755	5	109	29	91.63	MECATRONICA	José Gamboa	24.07609	-104.5546	775
20192807	2807	5	96	32	85.18	INDUSTRIAL	José Gamboa	24.07609	-104.5546	560
20194193	4193	8	141	28	82.17	QUIMICA	José Gamboa	24.07609	-104.5546	871
20190813	813	2	20	20	88.20	ARQUITECTURA	José Gamboa	24.07609	-104.5546	161
20193397	3397	9	178	23	82.05	MECANICA	José Gamboa	24.07609	-104.5546	701
20195406	5406	3	50	27	89.82	INFORMATICA	José Gamboa	24.07609	-104.5546	1106
20192824	2824	3	61	22	81.57	INDUSTRIAL	José Gamboa	24.07609	-104.5546	564
20193247	3247	7	179	31	94.61	INDUSTRIAL	José Gamboa	24.07609	-104.5546	665
20193650	3650	3	52	32	79.00	MECANICA	José Gamboa	24.07609	-104.5546	752
20192005	2005	8	203	18	88.86	CIVIL	José Gamboa	24.07609	-104.5546	384
20191003	1003	2	26	26	90.33	ARQUITECTURA	José Gamboa	24.07609	-104.5546	196
20195076	5076	6	98	24	86.05	GESTION EMPRESARIAL	José Gamboa	24.07609	-104.5546	1048
20191334	1334	1	NA	23	0.00	BIOQUIMICA	José Gamboa	24.07609	-104.5546	260

muestraloc2 <- sample(loc2, round(n * frloc2, 0))
kable(muestraloc1, caption = paste("La muestra de alumnos de Localidad ",tabla_frec$Category[2] ))

La muestra de alumnos de Localidad Tierra Prometida

No. Control	Alumno	Semestre	Cr. Apr.	Carga	Promedio	Carrera	localidad	latitud	longitud	orig.id
20194278	4278	7	172	32	91.36	QUIMICA	José Gamboa	24.07609	-104.5546	891
20194700	4700	11	205	30	83.65	GESTION EMPRESARIAL	José Gamboa	24.07609	-104.5546	977
20193753	3753	6	109	36	90.46	MECATRONICA	José Gamboa	24.07609	-104.5546	774
20192092	2092	8	156	20	80.18	CIVIL	José Gamboa	24.07609	-104.5546	404
20191273	1273	4	82	31	85.94	BIOQUIMICA	José Gamboa	24.07609	-104.5546	249
20191508	1508	1	NA	23	0.00	BIOQUIMICA	José Gamboa	24.07609	-104.5546	292
20192338	2338	1	NA	24	0.00	ELECTRICA	José Gamboa	24.07609	-104.5546	454
20191070	1070	8	202	25	82.59	ARQUITECTURA	José Gamboa	24.07609	-104.5546	211
20193755	3755	5	109	29	91.63	MECATRONICA	José Gamboa	24.07609	-104.5546	775
20192807	2807	5	96	32	85.18	INDUSTRIAL	José Gamboa	24.07609	-104.5546	560
20194193	4193	8	141	28	82.17	QUIMICA	José Gamboa	24.07609	-104.5546	871
20190813	813	2	20	20	88.20	ARQUITECTURA	José Gamboa	24.07609	-104.5546	161
20193397	3397	9	178	23	82.05	MECANICA	José Gamboa	24.07609	-104.5546	701
20195406	5406	3	50	27	89.82	INFORMATICA	José Gamboa	24.07609	-104.5546	1106
20192824	2824	3	61	22	81.57	INDUSTRIAL	José Gamboa	24.07609	-104.5546	564
20193247	3247	7	179	31	94.61	INDUSTRIAL	José Gamboa	24.07609	-104.5546	665
20193650	3650	3	52	32	79.00	MECANICA	José Gamboa	24.07609	-104.5546	752
20192005	2005	8	203	18	88.86	CIVIL	José Gamboa	24.07609	-104.5546	384
20191003	1003	2	26	26	90.33	ARQUITECTURA	José Gamboa	24.07609	-104.5546	196
20195076	5076	6	98	24	86.05	GESTION EMPRESARIAL	José Gamboa	24.07609	-104.5546	1048
20191334	1334	1	NA	23	0.00	BIOQUIMICA	José Gamboa	24.07609	-104.5546	260

muestraloc3 <- sample(loc3, round(n * frloc3, 0))
kable(muestraloc1, caption = paste("La muestra de alumnos de Localidad ",tabla_frec$Category[3] ))

La muestra de alumnos de Localidad Residencial Los Arcos [Fraccionamiento]

No. Control	Alumno	Semestre	Cr. Apr.	Carga	Promedio	Carrera	localidad	latitud	longitud	orig.id
20194278	4278	7	172	32	91.36	QUIMICA	José Gamboa	24.07609	-104.5546	891
20194700	4700	11	205	30	83.65	GESTION EMPRESARIAL	José Gamboa	24.07609	-104.5546	977
20193753	3753	6	109	36	90.46	MECATRONICA	José Gamboa	24.07609	-104.5546	774
20192092	2092	8	156	20	80.18	CIVIL	José Gamboa	24.07609	-104.5546	404
20191273	1273	4	82	31	85.94	BIOQUIMICA	José Gamboa	24.07609	-104.5546	249
20191508	1508	1	NA	23	0.00	BIOQUIMICA	José Gamboa	24.07609	-104.5546	292
20192338	2338	1	NA	24	0.00	ELECTRICA	José Gamboa	24.07609	-104.5546	454
20191070	1070	8	202	25	82.59	ARQUITECTURA	José Gamboa	24.07609	-104.5546	211
20193755	3755	5	109	29	91.63	MECATRONICA	José Gamboa	24.07609	-104.5546	775
20192807	2807	5	96	32	85.18	INDUSTRIAL	José Gamboa	24.07609	-104.5546	560
20194193	4193	8	141	28	82.17	QUIMICA	José Gamboa	24.07609	-104.5546	871
20190813	813	2	20	20	88.20	ARQUITECTURA	José Gamboa	24.07609	-104.5546	161
20193397	3397	9	178	23	82.05	MECANICA	José Gamboa	24.07609	-104.5546	701
20195406	5406	3	50	27	89.82	INFORMATICA	José Gamboa	24.07609	-104.5546	1106
20192824	2824	3	61	22	81.57	INDUSTRIAL	José Gamboa	24.07609	-104.5546	564
20193247	3247	7	179	31	94.61	INDUSTRIAL	José Gamboa	24.07609	-104.5546	665
20193650	3650	3	52	32	79.00	MECANICA	José Gamboa	24.07609	-104.5546	752
20192005	2005	8	203	18	88.86	CIVIL	José Gamboa	24.07609	-104.5546	384
20191003	1003	2	26	26	90.33	ARQUITECTURA	José Gamboa	24.07609	-104.5546	196
20195076	5076	6	98	24	86.05	GESTION EMPRESARIAL	José Gamboa	24.07609	-104.5546	1048
20191334	1334	1	NA	23	0.00	BIOQUIMICA	José Gamboa	24.07609	-104.5546	260

muestraloc4 <- sample(loc4, round(n * frloc4, 0))
kable(muestraloc1, caption = paste("La muestra de alumnos de Localidad ",tabla_frec$Category[4] ))

La muestra de alumnos de Localidad Rancho San Pablo

No. Control	Alumno	Semestre	Cr. Apr.	Carga	Promedio	Carrera	localidad	latitud	longitud	orig.id
20194278	4278	7	172	32	91.36	QUIMICA	José Gamboa	24.07609	-104.5546	891
20194700	4700	11	205	30	83.65	GESTION EMPRESARIAL	José Gamboa	24.07609	-104.5546	977
20193753	3753	6	109	36	90.46	MECATRONICA	José Gamboa	24.07609	-104.5546	774
20192092	2092	8	156	20	80.18	CIVIL	José Gamboa	24.07609	-104.5546	404
20191273	1273	4	82	31	85.94	BIOQUIMICA	José Gamboa	24.07609	-104.5546	249
20191508	1508	1	NA	23	0.00	BIOQUIMICA	José Gamboa	24.07609	-104.5546	292
20192338	2338	1	NA	24	0.00	ELECTRICA	José Gamboa	24.07609	-104.5546	454
20191070	1070	8	202	25	82.59	ARQUITECTURA	José Gamboa	24.07609	-104.5546	211
20193755	3755	5	109	29	91.63	MECATRONICA	José Gamboa	24.07609	-104.5546	775
20192807	2807	5	96	32	85.18	INDUSTRIAL	José Gamboa	24.07609	-104.5546	560
20194193	4193	8	141	28	82.17	QUIMICA	José Gamboa	24.07609	-104.5546	871
20190813	813	2	20	20	88.20	ARQUITECTURA	José Gamboa	24.07609	-104.5546	161
20193397	3397	9	178	23	82.05	MECANICA	José Gamboa	24.07609	-104.5546	701
20195406	5406	3	50	27	89.82	INFORMATICA	José Gamboa	24.07609	-104.5546	1106
20192824	2824	3	61	22	81.57	INDUSTRIAL	José Gamboa	24.07609	-104.5546	564
20193247	3247	7	179	31	94.61	INDUSTRIAL	José Gamboa	24.07609	-104.5546	665
20193650	3650	3	52	32	79.00	MECANICA	José Gamboa	24.07609	-104.5546	752
20192005	2005	8	203	18	88.86	CIVIL	José Gamboa	24.07609	-104.5546	384
20191003	1003	2	26	26	90.33	ARQUITECTURA	José Gamboa	24.07609	-104.5546	196
20195076	5076	6	98	24	86.05	GESTION EMPRESARIAL	José Gamboa	24.07609	-104.5546	1048
20191334	1334	1	NA	23	0.00	BIOQUIMICA	José Gamboa	24.07609	-104.5546	260

muestraloc5 <- sample(loc5, round(n * frloc5, 0))
kable(muestraloc1, caption = paste("La muestra de alumnos de Localidad ",tabla_frec$Category[5] ))

La muestra de alumnos de Localidad Rancho el Bajío

No. Control	Alumno	Semestre	Cr. Apr.	Carga	Promedio	Carrera	localidad	latitud	longitud	orig.id
20194278	4278	7	172	32	91.36	QUIMICA	José Gamboa	24.07609	-104.5546	891
20194700	4700	11	205	30	83.65	GESTION EMPRESARIAL	José Gamboa	24.07609	-104.5546	977
20193753	3753	6	109	36	90.46	MECATRONICA	José Gamboa	24.07609	-104.5546	774
20192092	2092	8	156	20	80.18	CIVIL	José Gamboa	24.07609	-104.5546	404
20191273	1273	4	82	31	85.94	BIOQUIMICA	José Gamboa	24.07609	-104.5546	249
20191508	1508	1	NA	23	0.00	BIOQUIMICA	José Gamboa	24.07609	-104.5546	292
20192338	2338	1	NA	24	0.00	ELECTRICA	José Gamboa	24.07609	-104.5546	454
20191070	1070	8	202	25	82.59	ARQUITECTURA	José Gamboa	24.07609	-104.5546	211
20193755	3755	5	109	29	91.63	MECATRONICA	José Gamboa	24.07609	-104.5546	775
20192807	2807	5	96	32	85.18	INDUSTRIAL	José Gamboa	24.07609	-104.5546	560
20194193	4193	8	141	28	82.17	QUIMICA	José Gamboa	24.07609	-104.5546	871
20190813	813	2	20	20	88.20	ARQUITECTURA	José Gamboa	24.07609	-104.5546	161
20193397	3397	9	178	23	82.05	MECANICA	José Gamboa	24.07609	-104.5546	701
20195406	5406	3	50	27	89.82	INFORMATICA	José Gamboa	24.07609	-104.5546	1106
20192824	2824	3	61	22	81.57	INDUSTRIAL	José Gamboa	24.07609	-104.5546	564
20193247	3247	7	179	31	94.61	INDUSTRIAL	José Gamboa	24.07609	-104.5546	665
20193650	3650	3	52	32	79.00	MECANICA	José Gamboa	24.07609	-104.5546	752
20192005	2005	8	203	18	88.86	CIVIL	José Gamboa	24.07609	-104.5546	384
20191003	1003	2	26	26	90.33	ARQUITECTURA	José Gamboa	24.07609	-104.5546	196
20195076	5076	6	98	24	86.05	GESTION EMPRESARIAL	José Gamboa	24.07609	-104.5546	1048
20191334	1334	1	NA	23	0.00	BIOQUIMICA	José Gamboa	24.07609	-104.5546	260

Visualizar con mapas

#install.packages("leaflet")

library(leaflet)

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

map<-leaflet() %>%
  addTiles() %>%
  addMarkers(lat=localidades50$Lat_Decimal[1],lng=localidades50$Lon_Decimal[1] ,popup=paste(localidades50$Nom_Loc[1], " ", tabla_frec$muestra[1])) %>%
   addMarkers(lat=localidades50$Lat_Decimal[2],lng=localidades50$Lon_Decimal[2] ,popup=paste(localidades50$Nom_Loc[2], " ", tabla_frec$muestra[2])) %>%
   addMarkers(lat=localidades50$Lat_Decimal[3],lng=localidades50$Lon_Decimal[3] ,popup=paste(localidades50$Nom_Loc[3], " ", tabla_frec$muestra[3])) %>%
   addMarkers(lat=localidades50$Lat_Decimal[4],lng=localidades50$Lon_Decimal[4] ,popup=paste(localidades50$Nom_Loc[4], " ", tabla_frec$muestra[4])) %>%
   addMarkers(lat=localidades50$Lat_Decimal[5],lng=localidades50$Lon_Decimal[5] ,popup=paste(localidades50$Nom_Loc[5], " ", tabla_frec$muestra[5]))
  
# Mostrar el mapa 
map

Interpretacion

Cada sujeto tiene una probabilidad igual de ser seleccionado para el estudio, se necesita una lista numerada de las unidades de la población que se quiere muestrear.