Proyecto de Métodos Estadísticos
2024-08-12
#install.packages(c("ggcorrplot", "readxl", "dplyr", "tidyverse", "Amelia", "janitor", "magrittr", "ggplot2", "pastecs", "nortest"))library(ggcorrplot)## Cargando paquete requerido: ggplot2library(readxl)
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ✔ readr 2.1.5## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(Amelia)## Cargando paquete requerido: Rcpp
## ##
## ## Amelia II: Multiple Imputation
## ## (Version 1.8.2, built: 2024-04-10)
## ## Copyright (C) 2005-2024 James Honaker, Gary King and Matthew Blackwell
## ## Refer to http://gking.harvard.edu/amelia/ for more information
## ##library(janitor)##
## Adjuntando el paquete: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.testlibrary(magrittr)##
## Adjuntando el paquete: 'magrittr'
##
## The following object is masked from 'package:purrr':
##
## set_names
##
## The following object is masked from 'package:tidyr':
##
## extractlibrary(ggplot2)
library(dplyr)
library(pastecs)##
## Adjuntando el paquete: 'pastecs'
##
## The following object is masked from 'package:magrittr':
##
## extract
##
## The following object is masked from 'package:tidyr':
##
## extract
##
## The following objects are masked from 'package:dplyr':
##
## first, lastlibrary(nortest)Importar Datos
Data <- read.csv('colombianos_exterior.csv')# Renombrar columnas con caracteres especiales
names(Data) <- c("País", "Codigo.ISO.Pais", "Oficina.de.registro", "Grupo.edad", "Edad",
"Area.Conocimiento", "Sub.Area.Conocimiento", "Nivel.Académico",
"Estado.civil", "Genero", "Etnia.de.la.persona", "Estatura",
"Localizacion", "Cantidad.de.personas")Resumen de los datos
summary(Data)## País Codigo.ISO.Pais Oficina.de.registro Grupo.edad
## Length:782250 Length:782250 Length:782250 Length:782250
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## Edad Area.Conocimiento Sub.Area.Conocimiento Nivel.Académico
## Min. : -1.00 Length:782250 Length:782250 Length:782250
## 1st Qu.: 34.00 Class :character Class :character Class :character
## Median : 44.00 Mode :character Mode :character Mode :character
## Mean : 45.79
## 3rd Qu.: 57.00
## Max. :140.00
## Estado.civil Genero Etnia.de.la.persona Estatura
## Length:782250 Length:782250 Length:782250 Length:782250
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## Localizacion Cantidad.de.personas
## Length:782250 Min. : 1.000
## Class :character 1st Qu.: 1.000
## Mode :character Median : 1.000
## Mean : 1.983
## 3rd Qu.: 1.000
## Max. :408.000dim(Data)## [1] 782250 14str(Data)## 'data.frame': 782250 obs. of 14 variables:
## $ País : chr "ALEMANIA" "ESPAÑA" "CANADA" "VENEZUELA" ...
## $ Codigo.ISO.Pais : chr "DEU" "ESP" "CAN" "VEN" ...
## $ Oficina.de.registro : chr "C. BERLIN" "C. BARCELONA" "C. MONTREAL" "C. MARACAIBO" ...
## $ Grupo.edad : chr "ADULTO" "ADULTO" "ADULTO" "ADULTO MAYOR" ...
## $ Edad : int 35 36 35 91 51 35 12 58 45 14 ...
## $ Area.Conocimiento : chr "CIENCIAS SOCIALES Y HUMANAS" "NO INDICA" "CIENCIAS SOCIALES Y HUMANAS" "CIENCIAS SOCIALES Y HUMANAS" ...
## $ Sub.Area.Conocimiento: chr "CIENCIA POLÍTICA Y/O RELACIONES INTERNACIONALES" "NO INDICA" "GEOGRAFÍA O HISTORIA" "DERECHO Y AFINES" ...
## $ Nivel.Académico : chr "PREGRADO - PROFESIONAL" "POSTGRADO - MAESTRIA" "NO INDICA" "NO INDICA" ...
## $ Estado.civil : chr "SOLTERO" "SOLTERO" "SOLTERO" "SOLTERO" ...
## $ Genero : chr "MASCULINO" "FEMENINO" "FEMENINO" "FEMENINO" ...
## $ Etnia.de.la.persona : chr "NINGUNA" "OTRO" "OTRO" "NINGUNA" ...
## $ Estatura : chr "-1" "165" "-1" "-1" ...
## $ Localizacion : chr "(51.165691, 10.451526)" "(40.463667, -3.74922)" "(56.130366, -106.346771)" "(6.42375, -66.58973)" ...
## $ Cantidad.de.personas : int 1 1 1 1 1 1 1 1 1 1 ...Se observa que inicialmente se tienen 12/14 variables cualitativas y 2/14 cuantitativas, sin embargo, si observamos la variable estatura sabemos que la naturaliza de sus datos es cuantitativa, y esta siendo detectada como una variable cualitativa, por lo tanto se designará manualmente.
Mapa de datos crudos
missmap(Data, main="Mapa de Datos Faltantes en Datos crudos")
Procesamiento de variables
Data$Estatura <- as.numeric(Data$Estatura)## Warning: NAs introducidos por coerciónData_nuevo <- Datastr(Data_nuevo)## 'data.frame': 782250 obs. of 14 variables:
## $ País : chr "ALEMANIA" "ESPAÑA" "CANADA" "VENEZUELA" ...
## $ Codigo.ISO.Pais : chr "DEU" "ESP" "CAN" "VEN" ...
## $ Oficina.de.registro : chr "C. BERLIN" "C. BARCELONA" "C. MONTREAL" "C. MARACAIBO" ...
## $ Grupo.edad : chr "ADULTO" "ADULTO" "ADULTO" "ADULTO MAYOR" ...
## $ Edad : int 35 36 35 91 51 35 12 58 45 14 ...
## $ Area.Conocimiento : chr "CIENCIAS SOCIALES Y HUMANAS" "NO INDICA" "CIENCIAS SOCIALES Y HUMANAS" "CIENCIAS SOCIALES Y HUMANAS" ...
## $ Sub.Area.Conocimiento: chr "CIENCIA POLÍTICA Y/O RELACIONES INTERNACIONALES" "NO INDICA" "GEOGRAFÍA O HISTORIA" "DERECHO Y AFINES" ...
## $ Nivel.Académico : chr "PREGRADO - PROFESIONAL" "POSTGRADO - MAESTRIA" "NO INDICA" "NO INDICA" ...
## $ Estado.civil : chr "SOLTERO" "SOLTERO" "SOLTERO" "SOLTERO" ...
## $ Genero : chr "MASCULINO" "FEMENINO" "FEMENINO" "FEMENINO" ...
## $ Etnia.de.la.persona : chr "NINGUNA" "OTRO" "OTRO" "NINGUNA" ...
## $ Estatura : num -1 165 -1 -1 169 -1 -1 -1 -1 -1 ...
## $ Localizacion : chr "(51.165691, 10.451526)" "(40.463667, -3.74922)" "(56.130366, -106.346771)" "(6.42375, -66.58973)" ...
## $ Cantidad.de.personas : int 1 1 1 1 1 1 1 1 1 1 ...names(Data)## [1] "País" "Codigo.ISO.Pais" "Oficina.de.registro"
## [4] "Grupo.edad" "Edad" "Area.Conocimiento"
## [7] "Sub.Area.Conocimiento" "Nivel.Académico" "Estado.civil"
## [10] "Genero" "Etnia.de.la.persona" "Estatura"
## [13] "Localizacion" "Cantidad.de.personas"#library(Amelia)
DataNA <- Data_nuevo
DataNA$Estatura[DataNA$Estatura==-1]<-NA
DataNA$Edad[DataNA$Edad==-1]<-NA
DataNA$Edad[DataNA$Edad>121]<-NA
DataNA$Estatura[DataNA$Estatura>270]<-NA
DataNA$Estatura[DataNA$Estatura<35]<-NAMapa de datos semiprocesados
missmap(DataNA, main="Mapa de Datos Faltantes semiprocesados")
Pruebas de Normalidad
Test Lilliefors
# Eliminar valores NA
clean_data <- na.omit(DataNA$Estatura)
# Realizar la prueba de normalidad (Lilliefors)
resultado_prueba <- lillie.test(clean_data)
print(resultado_prueba)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: clean_data
## D = 0.094772, p-value < 2.2e-16# Nivel de significancia
nivel_significancia <- 0.05
# Evaluar la hipótesis
if (!is.na(resultado_prueba$p.value) && resultado_prueba$p.value < nivel_significancia) {
print("Se rechaza la hipótesis nula, lo que sugiere que la variable Estatura no sigue una distribución normal.")
} else {
print("No se rechaza la hipótesis nula, lo que sugiere que la variable Estatura sigue una distribución normal.")
}## [1] "Se rechaza la hipótesis nula, lo que sugiere que la variable Estatura no sigue una distribución normal."#Verificación Gráfica
# Crear el gráfico QQ para la variable Edad
qqnorm(DataNA$Estatura, main = "QQ Plot para la variable Estatura")
qqline(DataNA$Estatura, col = "red", lwd = 2)
# Crear el gráfico QQ para la variable Edad
qqnorm(DataNA$Edad, main = "QQ Plot para la variable Edad")
qqline(DataNA$Edad, col = "red", lwd = 2)
# Crear el gráfico QQ para la variable Edad
qqnorm(DataNA$Cantidad.de.personas, main = "QQ Plot para la Cantidad de personas")
qqline(DataNA$Cantidad.de.personas, col = "red", lwd = 2)
# Definir la función para aplicar el test Lilliefors
lilliefors_test <- function(x) {
# Eliminar NA antes de realizar la prueba
clean_data <- na.omit(x)
# Aplicar el test Lilliefors y extraer el p-value
result <- lillie.test(clean_data)
return(result$p.value)
}
# Aplicar la prueba de Lilliefors a todas las variables numéricas
normality_tests <- DataNA %>%
summarise(across(where(is.numeric), ~ lilliefors_test(.x))) %>%
pivot_longer(cols = everything(), names_to = "Variable", values_to = "P-Value")
# Agregar una columna indicando si los datos son normales o no
normality_tests <- normality_tests %>%
mutate(Normal = ifelse(`P-Value` < 0.05, "No", "Sí"))
# Mostrar los resultados
print(normality_tests)## # A tibble: 3 × 3
## Variable `P-Value` Normal
## <chr> <dbl> <chr>
## 1 Edad 0 No
## 2 Estatura 0 No
## 3 Cantidad.de.personas 0 NoTest Kolmogorov-Smirnov
ks_test <- function(x) {
clean_data <- na.omit(x)
ks.test(clean_data, "pnorm", mean = mean(clean_data), sd = sd(clean_data))$p.value
}
# Aplicar la prueba de Kolmogorov-Smirnov a todas las variables numéricas
normality_tests <- DataNA %>%
summarise(across(where(is.numeric), ~ ks_test(.x))) %>%
pivot_longer(cols = everything(), names_to = "Variable", values_to = "P-Value")## Warning: There were 3 warnings in `summarise()`.
## The first warning was:
## ℹ In argument: `across(where(is.numeric), ~ks_test(.x))`.
## Caused by warning in `ks.test.default()`:
## ! ties should not be present for the one-sample Kolmogorov-Smirnov test
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 2 remaining warnings.# Agregar una columna indicando si los datos son normales o no
normality_tests <- normality_tests %>%
mutate(Normal = ifelse(`P-Value` < 0.05, "No", "Sí"))
# Mostrar los resultados
print(normality_tests)## # A tibble: 3 × 3
## Variable `P-Value` Normal
## <chr> <dbl> <chr>
## 1 Edad 0 No
## 2 Estatura 0 No
## 3 Cantidad.de.personas 0 NoBasandonos en los resultados de la Prueba de normalidad Lilliefors para las variables que los datos no son normales, por lo que que se decide reemplazar los NA’s con la mediana y, en las variables cualitativas por la moda.
Datos limpios
# Función para rellenar variables cuantitativas con la mediana
rellenar_con_mediana <- function(x) {
x[is.na(x)] <- median(x, na.rm = TRUE)
return(x)
}
# Función para calcular la moda
calcular_moda <- function(x) {
uniq_vals <- unique(na.omit(x))
uniq_vals[which.max(tabulate(match(x, uniq_vals)))]
}
# Función para rellenar NA en variables cualitativas con la moda
rellenar_con_moda <- function(x) {
moda <- calcular_moda(x)
x[is.na(x)] <- moda
return(x)
}DataNA <- DataNA %>%
mutate(across(where(is.numeric), rellenar_con_mediana)) %>%
mutate(across(where(is.character), rellenar_con_moda)) %>%
mutate(across(where(is.factor), ~ as.character(.) %>% rellenar_con_moda() %>% as.factor()))Visualización de datos limpios
names(DataNA)## [1] "País" "Codigo.ISO.Pais" "Oficina.de.registro"
## [4] "Grupo.edad" "Edad" "Area.Conocimiento"
## [7] "Sub.Area.Conocimiento" "Nivel.Académico" "Estado.civil"
## [10] "Genero" "Etnia.de.la.persona" "Estatura"
## [13] "Localizacion" "Cantidad.de.personas"summary(DataNA)## País Codigo.ISO.Pais Oficina.de.registro Grupo.edad
## Length:782250 Length:782250 Length:782250 Length:782250
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## Edad Area.Conocimiento Sub.Area.Conocimiento Nivel.Académico
## Min. : 0.00 Length:782250 Length:782250 Length:782250
## 1st Qu.: 34.00 Class :character Class :character Class :character
## Median : 44.00 Mode :character Mode :character Mode :character
## Mean : 45.85
## 3rd Qu.: 57.00
## Max. :119.00
## Estado.civil Genero Etnia.de.la.persona Estatura
## Length:782250 Length:782250 Length:782250 Min. : 35.0
## Class :character Class :character Class :character 1st Qu.:165.0
## Mode :character Mode :character Mode :character Median :165.0
## Mean :164.8
## 3rd Qu.:165.0
## Max. :270.0
## Localizacion Cantidad.de.personas
## Length:782250 Min. : 1.000
## Class :character 1st Qu.: 1.000
## Mode :character Median : 1.000
## Mean : 1.983
## 3rd Qu.: 1.000
## Max. :408.000str(DataNA)## 'data.frame': 782250 obs. of 14 variables:
## $ País : chr "ALEMANIA" "ESPAÑA" "CANADA" "VENEZUELA" ...
## $ Codigo.ISO.Pais : chr "DEU" "ESP" "CAN" "VEN" ...
## $ Oficina.de.registro : chr "C. BERLIN" "C. BARCELONA" "C. MONTREAL" "C. MARACAIBO" ...
## $ Grupo.edad : chr "ADULTO" "ADULTO" "ADULTO" "ADULTO MAYOR" ...
## $ Edad : int 35 36 35 91 51 35 12 58 45 14 ...
## $ Area.Conocimiento : chr "CIENCIAS SOCIALES Y HUMANAS" "NO INDICA" "CIENCIAS SOCIALES Y HUMANAS" "CIENCIAS SOCIALES Y HUMANAS" ...
## $ Sub.Area.Conocimiento: chr "CIENCIA POLÍTICA Y/O RELACIONES INTERNACIONALES" "NO INDICA" "GEOGRAFÍA O HISTORIA" "DERECHO Y AFINES" ...
## $ Nivel.Académico : chr "PREGRADO - PROFESIONAL" "POSTGRADO - MAESTRIA" "NO INDICA" "NO INDICA" ...
## $ Estado.civil : chr "SOLTERO" "SOLTERO" "SOLTERO" "SOLTERO" ...
## $ Genero : chr "MASCULINO" "FEMENINO" "FEMENINO" "FEMENINO" ...
## $ Etnia.de.la.persona : chr "NINGUNA" "OTRO" "OTRO" "NINGUNA" ...
## $ Estatura : num 165 165 165 165 169 165 165 165 165 165 ...
## $ Localizacion : chr "(51.165691, 10.451526)" "(40.463667, -3.74922)" "(56.130366, -106.346771)" "(6.42375, -66.58973)" ...
## $ Cantidad.de.personas : num 1 1 1 1 1 1 1 1 1 1 ...dim(DataNA)## [1] 782250 14Mapa de datos limpios
# Verificar que no haya NA en el nuevo dataframe
missmap(DataNA, main="Mapa de Datos Faltantes")
Analizar Datos
# Crea la tabla de frecuencias
frecuencia_pais <- table(Data$País)
pais_agg_edad <- table(Data$País, Data$Grupo.edad)
# Ordena la tabla en orden descendente y selecciona los 10 primeros
top_countries <- sort(frecuencia_pais, decreasing = TRUE)[1:10]
# Crea la tabla de frecuencias
frecuencia_pais1 <- table(DataNA$País)
pais_agg_edad1 <- table(DataNA$País, DataNA$Grupo.edad)
# Ordena la tabla en orden descendente y selecciona los 10 primeros
top_countries1 <- sort(frecuencia_pais1, decreasing = TRUE)[1:10]# Grafico de barras para los primeros 10 paises
barplot(top_countries, las=2, col="skyblue", cex.names = 0.6, main="Top 10 países con más colombianos", ylab="")
# Grafico de barras para los primeros 10 paises
barplot(top_countries1, las=2, col="lightgreen", cex.names = 0.6, main="Top 10 países con más colombianos", ylab="")
#Area de conocimiento
frec_Area <- table(Data$Area.Conocimiento)
print(frec_Area)##
## (NO REGISTRA)
## 713
## AGRONOMÍA, VETERINARIA Y AFINES
## 5047
## AGRONOMÍA, VETERINARIA Y ZOOTECNIA
## 2725
## AVIACIÓN
## 1892
## BELLAS ARTES
## 28818
## CIENCIAS DE LA EDUCACIÓN
## 23230
## CIENCIAS DE LA SALUD
## 60672
## CIENCIAS SOCIALES Y HUMANAS
## 60682
## COCINA Y CULINARIA
## 3588
## ECONOMÍA, ADMINISTRACIÓN CONTADURIA Y AFINES
## 88555
## INGENIERÍA, ARQUITECTURA Y AFINES
## 95939
## MATEMÁTICAS Y CIENCIAS NATURALES
## 10962
## NINGUNA
## 190204
## NO INDICA
## 209223print(prop.table(frec_Area)*100)##
## (NO REGISTRA)
## 0.09114733
## AGRONOMÍA, VETERINARIA Y AFINES
## 0.64519016
## AGRONOMÍA, VETERINARIA Y ZOOTECNIA
## 0.34835411
## AVIACIÓN
## 0.24186641
## BELLAS ARTES
## 3.68398849
## CIENCIAS DE LA EDUCACIÓN
## 2.96963886
## CIENCIAS DE LA SALUD
## 7.75608821
## CIENCIAS SOCIALES Y HUMANAS
## 7.75736657
## COCINA Y CULINARIA
## 0.45867689
## ECONOMÍA, ADMINISTRACIÓN CONTADURIA Y AFINES
## 11.32054970
## INGENIERÍA, ARQUITECTURA Y AFINES
## 12.26449345
## MATEMÁTICAS Y CIENCIAS NATURALES
## 1.40134228
## NINGUNA
## 24.31498881
## NO INDICA
## 26.74630872barplot(frec_Area,
xlab = " ",
ylab = " ",
main = "Distribución de areas de concimiento",
col = "orange",
las = 3,
cex.names = 0.4)
#Area de conocimiento
frec_Area1 <- table(DataNA$Area.Conocimiento)
print(frec_Area1)##
## (NO REGISTRA)
## 713
## AGRONOMÍA, VETERINARIA Y AFINES
## 5047
## AGRONOMÍA, VETERINARIA Y ZOOTECNIA
## 2725
## AVIACIÓN
## 1892
## BELLAS ARTES
## 28818
## CIENCIAS DE LA EDUCACIÓN
## 23230
## CIENCIAS DE LA SALUD
## 60672
## CIENCIAS SOCIALES Y HUMANAS
## 60682
## COCINA Y CULINARIA
## 3588
## ECONOMÍA, ADMINISTRACIÓN CONTADURIA Y AFINES
## 88555
## INGENIERÍA, ARQUITECTURA Y AFINES
## 95939
## MATEMÁTICAS Y CIENCIAS NATURALES
## 10962
## NINGUNA
## 190204
## NO INDICA
## 209223print(prop.table(frec_Area1)*100)##
## (NO REGISTRA)
## 0.09114733
## AGRONOMÍA, VETERINARIA Y AFINES
## 0.64519016
## AGRONOMÍA, VETERINARIA Y ZOOTECNIA
## 0.34835411
## AVIACIÓN
## 0.24186641
## BELLAS ARTES
## 3.68398849
## CIENCIAS DE LA EDUCACIÓN
## 2.96963886
## CIENCIAS DE LA SALUD
## 7.75608821
## CIENCIAS SOCIALES Y HUMANAS
## 7.75736657
## COCINA Y CULINARIA
## 0.45867689
## ECONOMÍA, ADMINISTRACIÓN CONTADURIA Y AFINES
## 11.32054970
## INGENIERÍA, ARQUITECTURA Y AFINES
## 12.26449345
## MATEMÁTICAS Y CIENCIAS NATURALES
## 1.40134228
## NINGUNA
## 24.31498881
## NO INDICA
## 26.74630872barplot(frec_Area1,
xlab = " ",
ylab = " ",
main = "Distribución de areas de concimiento",
col = "lightblue",
las = 3,
cex.names = 0.4)
#Nivel Academico
frec_Nivel<-table(Data$Nivel.Académico)
barplot(frec_Nivel,
xlab = " ",
ylab = " ",
main = "Distribución de nivel academico",
col = "pink",
las = 3,
cex.names = 0.4)
print(frec_Nivel)##
## (NO REGISTRA) BACHILLERATO
## 713 148056
## NINGUNO NO INDICA
## 17062 271466
## POSTGRADO - DOCTORADO POSTGRADO - ESPECIALIZACIÓN
## 7468 20619
## POSTGRADO - MAESTRIA PREGRADO - PROFESIONAL
## 32865 137517
## PREGRADO - TÉCNICO PROFESIONAL PREGRADO - TECNOLÓGICO
## 52792 28101
## PRIMARIA SIN PROFESIÓN
## 65411 180print(prop.table(frec_Nivel)*100)##
## (NO REGISTRA) BACHILLERATO
## 0.09114733 18.92694151
## NINGUNO NO INDICA
## 2.18114414 34.70322787
## POSTGRADO - DOCTORADO POSTGRADO - ESPECIALIZACIÓN
## 0.95468201 2.63585810
## POSTGRADO - MAESTRIA PREGRADO - PROFESIONAL
## 4.20134228 17.57967402
## PREGRADO - TÉCNICO PROFESIONAL PREGRADO - TECNOLÓGICO
## 6.74873762 3.59232982
## PRIMARIA SIN PROFESIÓN
## 8.36190476 0.02301055#Nivel Academico limpio
frec_Nivel1<-table(DataNA$Nivel.Académico)
barplot(frec_Nivel1,
xlab = " ",
ylab = " ",
main = "Distribución de nivel academico",
col = "yellow",
las = 3,
cex.names = 0.4)
print(frec_Nivel1)##
## (NO REGISTRA) BACHILLERATO
## 713 148056
## NINGUNO NO INDICA
## 17062 271466
## POSTGRADO - DOCTORADO POSTGRADO - ESPECIALIZACIÓN
## 7468 20619
## POSTGRADO - MAESTRIA PREGRADO - PROFESIONAL
## 32865 137517
## PREGRADO - TÉCNICO PROFESIONAL PREGRADO - TECNOLÓGICO
## 52792 28101
## PRIMARIA SIN PROFESIÓN
## 65411 180print(prop.table(frec_Nivel1)*100)##
## (NO REGISTRA) BACHILLERATO
## 0.09114733 18.92694151
## NINGUNO NO INDICA
## 2.18114414 34.70322787
## POSTGRADO - DOCTORADO POSTGRADO - ESPECIALIZACIÓN
## 0.95468201 2.63585810
## POSTGRADO - MAESTRIA PREGRADO - PROFESIONAL
## 4.20134228 17.57967402
## PREGRADO - TÉCNICO PROFESIONAL PREGRADO - TECNOLÓGICO
## 6.74873762 3.59232982
## PRIMARIA SIN PROFESIÓN
## 8.36190476 0.02301055# Crear un data frame con las frecuencias de Genero
frec_Genre <- table(DataNA$Genero)
datos_genero <- as.data.frame(table(DataNA$Genero))
names(datos_genero) <- c("Genero", "Frecuencia")dato_por_genero <- DataNA %>%
group_by(Genero) %>%
count() %>%
ungroup() %>%
mutate(Porcentaje = n / sum(n)) %>%
arrange(Porcentaje) %>%
mutate(etiquetas = scales::percent(Porcentaje))
colors <- c("lightgreen", "#DEB7D9", "lightyellow", "gray")
ggplot(dato_por_genero, aes(x = "", y = Porcentaje, fill = Genero)) +
geom_col(color = "black") +
geom_label(aes(label = etiquetas),
position = position_stack(vjust = 0.5),
show.legend = FALSE) +
scale_fill_manual(values = colors) +
guides(fill = guide_legend(title = "Cantidad de sujetos según género")) +
coord_polar(theta = "y") +
ggtitle("")
#solo hay 7 no binario# Crear el gráfico de barras
frec_Genre <- table(Data$Genero)
barplot_heights <- barplot(frec_Genre,
xlab = " ",
ylab = " ",
main = "Distribución de Género",
col = "yellow",
las = 2,
cex.names = 0.6)
# Agregar los números encima de las columnas
text(x = barplot_heights,
y = frec_Genre + max(frec_Genre) * 0.02,
labels = frec_Genre,
cex = 0.8) 
# Mostrar la tabla de frecuencias y proporciones
print(frec_Genre)##
## DESCONOCIDO FEMENINO MASCULINO NO_BINARIO
## 1613 430898 349732 7print(prop.table(frec_Genre) * 100)##
## DESCONOCIDO FEMENINO MASCULINO NO_BINARIO
## 2.062001e-01 5.508444e+01 4.470847e+01 8.948546e-04# Cálculo de estadísticas descriptivas para Edad
summary(DataNA$Edad)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00 34.00 44.00 45.85 57.00 119.00media_edad <- mean(DataNA$Edad, na.rm = TRUE)
mediana_edad <- median(DataNA$Edad, na.rm = TRUE)
desviacion_estandar_edad <- sd(DataNA$Edad, na.rm = TRUE)
varianza_edad <- var(DataNA$Edad, na.rm = TRUE)
quantiles_edad <- quantile(DataNA$Edad, na.rm = TRUE)
print(paste("Media:", media_edad))## [1] "Media: 45.8460338766379"print(paste("Mediana:", mediana_edad))## [1] "Mediana: 44"print(paste("Desviación Estándar:", desviacion_estandar_edad))## [1] "Desviación Estándar: 16.0710736295257"print(paste("Varianza:", varianza_edad))## [1] "Varianza: 258.279407605637"print("Cuantiles:")## [1] "Cuantiles:"print(quantiles_edad)## 0% 25% 50% 75% 100%
## 0 34 44 57 119# Crear el gráfico de cajas y bigote EDAD
boxplot(DataNA$Edad,
main = "BOXPLOT EDAD", # Título del gráfico
ylab = "EDAD", # Etiqueta del eje y
col = "gray", # Color de las cajas
border = "black", # Color del borde de las cajas
horizontal = TRUE) # Graficar horizontalmente
#print(paste(mean(Data$Edad..años., na.rm = FALSE)))#Grupos de edad
frec_agg_Edad<-table(Data$Grupo.edad)
barplot(frec_agg_Edad,
xlab = " ",
ylab = " ",
main = "Distribución de Grupos de Edad",
col = "lightgreen",
las = 2,
cex.name = 0.6)
print(frec_agg_Edad)##
## ADOLESCENTE ADULTO ADULTO JOVEN ADULTO MAYOR
## 9780 533179 68714 159445
## DESCONOCIDO INFANTE PRIMERA INFANCIA
## 1018 7238 2876print(prop.table(frec_agg_Edad)*100)##
## ADOLESCENTE ADULTO ADULTO JOVEN ADULTO MAYOR
## 1.2502397 68.1596676 8.7841483 20.3828699
## DESCONOCIDO INFANTE PRIMERA INFANCIA
## 0.1301374 0.9252796 0.3676574#Estado Civil
frec_Civil<-table(Data$Estado.civil)
barplot(frec_Civil,
xlab = " ",
ylab = " ",
main = "Distribución de Estado Civil",
col = "green",
las = 2,
cex.name = 0.4)
print(frec_Civil)##
## CASADO DESCONOCIDO DIVORCIADO
## 265168 56712 48731
## SEPARADO_MATRIMONIO SEPARADO_UNION_LIBRE SOLTERO
## 2042 1014 325863
## UNION_LIBRE VIUDO
## 65410 17310print(prop.table(frec_Civil)*100)##
## CASADO DESCONOCIDO DIVORCIADO
## 33.8981144 7.2498562 6.2295941
## SEPARADO_MATRIMONIO SEPARADO_UNION_LIBRE SOLTERO
## 0.2610419 0.1296261 41.6571429
## UNION_LIBRE VIUDO
## 8.3617769 2.2128476#Estado Civil limpio
frec_Civil1<-table(DataNA$Estado.civil)
barplot(frec_Civil,
xlab = " ",
ylab = " ",
main = "Distribución de Estado Civil",
col = "pink",
las = 2,
cex.name = 0.4)
print(frec_Civil1)##
## CASADO DESCONOCIDO DIVORCIADO
## 265168 56712 48731
## SEPARADO_MATRIMONIO SEPARADO_UNION_LIBRE SOLTERO
## 2042 1014 325863
## UNION_LIBRE VIUDO
## 65410 17310print(prop.table(frec_Civil1)*100)##
## CASADO DESCONOCIDO DIVORCIADO
## 33.8981144 7.2498562 6.2295941
## SEPARADO_MATRIMONIO SEPARADO_UNION_LIBRE SOLTERO
## 0.2610419 0.1296261 41.6571429
## UNION_LIBRE VIUDO
## 8.3617769 2.2128476#Etnia
#Estado Civil
frec_Etnia<-table(DataNA$Etnia.de.la.persona)
barplot(frec_Etnia,
xlab = " ",
ylab = " ",
main = "Distribución de Etnia",
col = "peachpuff",
las = 2,
cex.name = 0.4)
print(frec_Etnia)##
## AFRODESCENDIENTE GITANO
## 17162 422
## INDÍGENA NINGUNA
## 3503 394827
## OTRO PALENQUERO DE SAN BASILIO
## 323110 149
## RAIZAL DEL ARCHIPIELAGO DE SAN ANDRES SIN ETNIA REGISTRADA
## 435 42642print(prop.table(frec_Etnia)*100)##
## AFRODESCENDIENTE GITANO
## 2.19392777 0.05394695
## INDÍGENA NINGUNA
## 0.44781080 50.47325024
## OTRO PALENQUERO DE SAN BASILIO
## 41.30520933 0.01904762
## RAIZAL DEL ARCHIPIELAGO DE SAN ANDRES SIN ETNIA REGISTRADA
## 0.05560882 5.45119847# Calcular las frecuencias de las etnias# Crear un gráfico de barras con escala logarítmica
barplot(log(frec_Etnia), names.arg = names(frec_Etnia), main = "Gráfico de Barras en Escala Logarítmica",
ylab = "Frecuencia (Escala Logarítmica)", col = "blue", las = 2)
# Ajustar etiquetas del eje Y para mostrar los valores originales
axis(2, at = log(pretty(range(frec_Etnia))), labels = pretty(range(frec_Etnia)))
# Crear gráfico de barras
barplot(frec_Etnia, log="y",
main="Frecuencias de Etnia en Escala Logarítmica",
ylab="", col="blue", las =2, cex.names = 0.6)
summary(Data$Estatura)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## -1.00 -1.00 -1.00 58.58 160.00 860.00 3media_height <- mean(Data$Estatura, na.rm = TRUE)
mediana_height <- median(Data$Estatura, na.rm = TRUE)
desviacion_estandar_height <- sd(Data$Estatura, na.rm = TRUE)
varianza_height <- var(Data$Estatura, na.rm = TRUE)
#quantiles_height <- quantile(Data$Estatura, na.rm = TRUE)
print(paste("Media:", media_height))## [1] "Media: 58.5750421542045"print(paste("Mediana:", mediana_height))## [1] "Mediana: -1"print(paste("Desviación Estándar:", desviacion_estandar_height))## [1] "Desviación Estándar: 79.7154145999075"print(paste("Varianza:", varianza_height))## [1] "Varianza: 6354.54732483515"#print("Cuantiles:")
#print(quantiles_height)#Estatura Limpia
summary(DataNA$Estatura)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 35.0 165.0 165.0 164.8 165.0 270.0media_height1 <- mean(DataNA$Estatura, na.rm = TRUE)
mediana_height1 <- median(DataNA$Estatura, na.rm = TRUE)
desviacion_estandar_height1 <- sd(DataNA$Estatura, na.rm = TRUE)
varianza_height1 <- var(DataNA$Estatura, na.rm = TRUE)
quantiles_height <- quantile(DataNA$Estatura, na.rm = TRUE)
print(paste("Media:", media_height1))## [1] "Media: 164.753218280601"print(paste("Mediana:", mediana_height1))## [1] "Mediana: 165"print(paste("Desviación Estándar:", desviacion_estandar_height1))## [1] "Desviación Estándar: 7.2075565768195"print(paste("Varianza:", varianza_height1))## [1] "Varianza: 51.948871808054"print("Cuantiles:")## [1] "Cuantiles:"print(quantiles_height)## 0% 25% 50% 75% 100%
## 35 165 165 165 270# Crear el gráfico de cajas y bigote Estatura
boxplot(DataNA$Estatura,
main = "BOXPLOT ESTATURA", # Título del gráfico
ylab = "ESTATURA", # Etiqueta del eje y
col = "purple", # Color de las cajas
border = "black", # Color del borde de las cajas
horizontal = TRUE)
print(max(Data$Estatura..CM.,na.rm = TRUE))## Warning in max(Data$Estatura..CM., na.rm = TRUE): ningun argumento finito para
## max; retornando -Inf## [1] -InfAnova <- aov(DataNA$Estatura~Data$Etnia.de.la.persona, data = Data)
summary.aov(Anova)## Df Sum Sq Mean Sq F value Pr(>F)
## Data$Etnia.de.la.persona 7 100672 14382 277.5 <2e-16 ***
## Residuals 782242 40536281 52
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(Anova)## Df Sum Sq Mean Sq F value Pr(>F)
## Data$Etnia.de.la.persona 7 100672 14382 277.5 <2e-16 ***
## Residuals 782242 40536281 52
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1boxplot(Data$Edad~Data$Etnia.de.la.persona,
xlab = "Promedio General", ylab = "Estrato Familiar",
main = "Distribución del Promedio General por Estrato Familiar",
col = "lightblue")
Anova <- aov(DataNA$Estatura~Data$Etnia.de.la.persona, data = DataNA)
summary.aov(Anova)## Df Sum Sq Mean Sq F value Pr(>F)
## Data$Etnia.de.la.persona 7 100672 14382 277.5 <2e-16 ***
## Residuals 782242 40536281 52
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(Anova)## Df Sum Sq Mean Sq F value Pr(>F)
## Data$Etnia.de.la.persona 7 100672 14382 277.5 <2e-16 ***
## Residuals 782242 40536281 52
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1boxplot(DataNA$Edad~DataNA$Etnia.de.la.persona,
xlab = "Promedio General", ylab = "Estrato Familiar",
main = "Distribución del Promedio General por Estrato Familiar",
col = "lightblue")
ggplot(DataNA, aes(x = Estado.civil, y = Edad, fill = Estado.civil)) +
geom_boxplot() +
facet_wrap(~ Genero) +
labs(x = "Estado civil", y = "Edad", title = "Distribución de la Edad por Etnia y Nivel Académico") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))