# -----------------------------------
# ANÁLISIS DE REMUNERACIÓN DE CONTRATISTAS
# ALCALDÍA DE NEIVA - 2020
# -----------------------------------
# 1. CARGAR LIBRERÍAS Y DATOS ----
library(readxl)
## Warning: package 'readxl' was built under R version 4.4.2
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, union
library(tidyr)
## Warning: package 'tidyr' was built under R version 4.4.3
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.4.2
library(sampling)
## Warning: package 'sampling' was built under R version 4.4.3
# Cargar datos desde el archivo Excel
datos <- read_excel("C:/Users/Usuario/Desktop/EPECIALIZACION EN ESTADISTICA/Taller 3.xlsx")
# Definir salario mínimo legal vigente 2020
SMLV_2020 <- 877803
# 2. DISEÑO MUESTRAL ESTRATIFICADO ----
# Tamaño total de muestra deseado
n_total <- 108
# Calcular tamaño de muestra por estrato (asignación proporcional)
tam_muestras <- datos %>%
count(Estrato) %>%
mutate(n_muestra = round(n * n_total / nrow(datos))) %>%
select(Estrato, n_muestra)
# Selección de la muestra estratificada
set.seed(123) # Para reproducibilidad
muestra <- strata(datos, stratanames = "Estrato",
size = tam_muestras$n_muestra,
method = "srswor")
# Extraer los datos de la muestra
datos_muestra <- getdata(datos, muestra)
# 3. ESTADÍSTICA DESCRIPTIVA ----
# Resumen por estrato
estadisticas <- datos_muestra %>%
group_by(Estrato) %>%
summarise(
n = n(),
Media_Ingreso = mean(`Ingreso Neto`),
Mediana_Ingreso = median(`Ingreso Neto`),
SD_Ingreso = sd(`Ingreso Neto`),
Min_Ingreso = min(`Ingreso Neto`),
Max_Ingreso = max(`Ingreso Neto`),
Porc_debajo_SMLV = mean(`Ingreso Neto` < SMLV_2020) * 100,
Porc_con_dependientes = mean(`No de Personas a Cargo` != "Ninguna") * 100
)
# Mostrar estadísticas descriptivas
print(estadisticas)
## # A tibble: 3 × 9
## Estrato n Media_Ingreso Mediana_Ingreso SD_Ingreso Min_Ingreso Max_Ingreso
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 36 728317. 723684. 96493. 575680 892024
## 2 2 36 1057467. 1058674. 73683. 934938 1196883
## 3 3 36 1559006. 1526560. 242227. 1208222 1963135
## # ℹ 2 more variables: Porc_debajo_SMLV <dbl>, Porc_con_dependientes <dbl>
# 4. VISUALIZACIÓN ----
# Boxplot de ingresos por estrato
ggplot(datos_muestra, aes(x = factor(Estrato), y = `Ingreso Neto`, fill = factor(Estrato))) +
geom_boxplot() +
geom_hline(yintercept = SMLV_2020, linetype = "dashed", color = "red") +
labs(title = "Distribución de Ingresos Netos por Estrato",
subtitle = "Línea roja: Salario Mínimo Legal Vigente 2020 ($877,803 COP)",
x = "Estrato",
y = "Ingreso Neto (COP)") +
scale_y_continuous(labels = scales::comma) +
theme_minimal()
# 5. INFERENCIA ESTADÍSTICA ----
# Función para calcular IC del 95%
calcular_ic <- function(x) {
n <- length(x)
media <- mean(x)
error <- qt(0.975, df = n-1) * sd(x)/sqrt(n)
return(c(media - error, media + error))
}
# Intervalos de confianza por estrato
intervalos_confianza <- datos_muestra %>%
group_by(Estrato) %>%
summarise(
Media = mean(`Ingreso Neto`),
IC_inferior = calcular_ic(`Ingreso Neto`)[1],
IC_superior = calcular_ic(`Ingreso Neto`)[2]
)
print(intervalos_confianza)
## # A tibble: 3 × 4
## Estrato Media IC_inferior IC_superior
## <dbl> <dbl> <dbl> <dbl>
## 1 1 728317. 695669. 760966.
## 2 2 1057467. 1032536. 1082398.
## 3 3 1559006. 1477049. 1640964.
# 6. PRUEBAS DE HIPÓTESIS ----
# Prueba t para cada estrato (H0: Media = SMLV)
pruebas_hipotesis <- datos_muestra %>%
group_by(Estrato) %>%
summarise(
Media = mean(`Ingreso Neto`),
t_stat = t.test(`Ingreso Neto`, mu = SMLV_2020)$statistic,
p_value = t.test(`Ingreso Neto`, mu = SMLV_2020)$p.value,
Diferencia = Media - SMLV_2020,
Conclusion = ifelse(p_value < 0.05,
ifelse(Diferencia > 0, "Mayor al SMLV", "Menor al SMLV"),
"No diferencia significativa")
)
print(pruebas_hipotesis)
## # A tibble: 3 × 6
## Estrato Media t_stat p_value Diferencia Conclusion
## <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 1 728317. -9.30 5.54e-11 -149486. Menor al SMLV
## 2 2 1057467. 14.6 1.76e-16 179664. Mayor al SMLV
## 3 3 1559006. 16.9 2.18e-18 681203. Mayor al SMLV
# 7. ANÁLISIS ADICIONAL: GASTOS VS INGRESOS ----
datos_muestra %>%
group_by(Estrato) %>%
summarise(
Porc_Gastos_Familiares = mean(`Gastos Familar (sinarriendo)` / `Ingreso Neto`) * 100,
Porc_Gastos_Arriendo = mean(`Gastos de Arriendo` / `Ingreso Neto`) * 100
)
## # A tibble: 3 × 3
## Estrato Porc_Gastos_Familiares Porc_Gastos_Arriendo
## <dbl> <dbl> <dbl>
## 1 1 48.5 28.7
## 2 2 44.4 24.9
## 3 3 42.4 21.9
# 8. EXPORTAR RESULTADOS ----
write.csv(estadisticas, "estadisticas_descriptivas.csv", row.names = FALSE)
write.csv(intervalos_confianza, "intervalos_confianza.csv", row.names = FALSE)
write.csv(pruebas_hipotesis, "pruebas_hipotesis.csv", row.names = FALSE)
# -----------------------------------
# CONCLUSIONES
# -----------------------------------
cat("\nCONCLUSIONES FINALES:\n")
##
## CONCLUSIONES FINALES:
cat("1. Todos los contratistas del Estrato 1 tienen ingresos menores al SMLV 2020\n")
## 1. Todos los contratistas del Estrato 1 tienen ingresos menores al SMLV 2020
cat("2. Los contratistas de Estratos 2 y 3 superan en promedio el SMLV\n")
## 2. Los contratistas de Estratos 2 y 3 superan en promedio el SMLV
cat("3. Existe una diferencia significativa entre estratos (p < 0.001 en todas las pruebas)\n")
## 3. Existe una diferencia significativa entre estratos (p < 0.001 en todas las pruebas)
cat("4. La proporción de gastos familiares es mayor en el Estrato 1\n")
## 4. La proporción de gastos familiares es mayor en el Estrato 1
# Cargar librerías necesarias
library(ggplot2)
library(dplyr)
library(tidyr)
# Definir salario mínimo
SMLV_2020 <- 877803
# Crear datos para la distribución normal por estrato
grafico_hipotesis <- datos_muestra %>%
group_by(Estrato) %>%
summarise(
media = mean(`Ingreso Neto`),
sd = sd(`Ingreso Neto`),
n = n(),
error_estandar = sd / sqrt(n),
t_stat = t.test(`Ingreso Neto`, mu = SMLV_2020)$statistic,
p_value = t.test(`Ingreso Neto`, mu = SMLV_2020)$p.value
) %>%
mutate(
Conclusion = ifelse(p_value < 0.05,
ifelse(media > SMLV_2020, "Mayor al SMLV", "Menor al SMLV"),
"No diferencia significativa")
)
# Función para generar datos de la distribución normal
generar_datos_normales <- function(media, sd, n = 1000) {
data.frame(
x = seq(media - 3*sd, media + 3*sd, length.out = n),
y = dnorm(seq(media - 3*sd, media + 3*sd, length.out = n), mean = media, sd = sd)
)
}
# Generar datos para cada estrato
datos_grafico <- grafico_hipotesis %>%
group_by(Estrato, media, sd, Conclusion) %>%
do(generar_datos_normales(.$media, .$sd)) %>%
ungroup()
# Crear el gráfico
ggplot(datos_grafico, aes(x = x, y = y)) +
# Campana de Gauss
geom_line(aes(color = factor(Estrato)), size = 1) +
# Línea vertical para la media muestral
geom_vline(data = grafico_hipotesis,
aes(xintercept = media, color = factor(Estrato)),
linetype = "dashed", size = 0.8) +
# Línea para el SMLV
geom_vline(xintercept = SMLV_2020, color = "red", size = 1.2) +
# Área de rechazo
geom_area(data = subset(datos_grafico, Estrato == 1 & x < SMLV_2020),
aes(x = x, y = y), fill = "#F8766D", alpha = 0.3) +
geom_area(data = subset(datos_grafico, Estrato == 2 & x > SMLV_2020),
aes(x = x, y = y), fill = "#00BA38", alpha = 0.3) +
geom_area(data = subset(datos_grafico, Estrato == 3 & x > SMLV_2020),
aes(x = x, y = y), fill = "#619CFF", alpha = 0.3) +
# Etiquetas
geom_label(data = grafico_hipotesis,
aes(x = media, y = max(datos_grafico$y)*0.9,
label = paste0("Media: $", round(media/1000, 1), "K\n",
"p-value: ", format.pval(p_value, digits = 2))),
size = 3.5) +
# Formateo visual
labs(title = "Prueba de Hipótesis por Estrato",
subtitle = "Comparación de ingresos con el Salario Mínimo Legal Vigente ($877,803 COP)",
x = "Ingreso Neto (COP)",
y = "Densidad",
color = "Estrato") +
scale_x_continuous(labels = scales::dollar_format(prefix = "$", big.mark = ".", decimal.mark = ",")) +
scale_color_manual(values = c("#F8766D", "#00BA38", "#619CFF")) +
theme_minimal() +
theme(legend.position = "top") +
facet_wrap(~ paste("Estrato", Estrato, "-", Conclusion), scales = "free")
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Versión con todas las campanas en un mismo gráfico
ggplot(datos_grafico, aes(x = x, y = y)) +
geom_line(aes(color = factor(Estrato)), size = 1) +
geom_vline(xintercept = SMLV_2020, color = "red", size = 1.2) +
geom_area(data = subset(datos_grafico, x < SMLV_2020),
aes(x = x, y = y, fill = factor(Estrato)), alpha = 0.3) +
geom_area(data = subset(datos_grafico, x > SMLV_2020),
aes(x = x, y = y, fill = factor(Estrato)), alpha = 0.3) +
scale_fill_manual(values = c("#F8766D", "#00BA38", "#619CFF")) +
scale_color_manual(values = c("#F8766D", "#00BA38", "#619CFF")) +
labs(title = "Distribución de Ingresos por Estrato",
subtitle = "Comparación con el Salario Mínimo Legal Vigente ($877,803 COP)",
x = "Ingreso Neto (COP)",
y = "Densidad",
color = "Estrato",
fill = "Estrato") +
scale_x_continuous(labels = scales::dollar_format(prefix = "$", big.mark = ".", decimal.mark = ",")) +
theme_minimal()
