FECHA: 24/12/2025
# Extraemos los datos
setwd("C:/Users/Usuario/Downloads")
# Extraemos los datos
df <- read.csv("soil_pollution_diseases.csv", sep = ";", stringsAsFactors = FALSE)
# Convertir la columna a fecha (día/mes/año)
df$Date_Reported <- as.Date(df$Date_Reported, format = "%d/%m/%Y")
# Extraemos la variable discreta (Mes)
Mes <- as.integer(format(df$Date_Reported, "%m"))
# TABLA DE DISTRIBUCIÓN DE FRECUENCIAS DE MESES
TDF_Mes <- table(Mes)
Tabla_Mes <- as.data.frame(TDF_Mes)
# Frecuencia absoluta y relativa
ni <- Tabla_Mes$Freq
hi <- round((ni / sum(ni)) * 100, 2)
Tabla_Mes_final <- data.frame(
Mes = as.character(Tabla_Mes$Mes),
ni = ni,
`hi (%)` = hi
)
# Fila TOTAL
Total <- data.frame(
Mes = "Total",
ni = sum(ni),
`hi (%)` = 100
)
TDF_Mes_Total <- rbind(Tabla_Mes_final, Total)
# =========================
# FORMATO gt
# =========================
library(gt)
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
tabla_meses_gt <- TDF_Mes_Total %>%
gt() %>%
tab_header(
title = md("*Tabla N° 3*"),
subtitle = md("**Tabla de distribución de frecuencias de los meses del estudio**")
) %>%
tab_source_note(
source_note = md("Autor: Grupo 3")
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
table.border.top.style = "solid",
table.border.bottom.style = "solid",
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
row.striping.include_table_body = TRUE,
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
table_body.hlines.color = "gray",
table_body.border.bottom.color = "black"
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(rows = Mes == "Total")
)
tabla_meses_gt
| Tabla N° 3 |
| Tabla de distribución de frecuencias de los meses del estudio |
| Mes |
ni |
hi.... |
| 1 |
235 |
7.83 |
| 2 |
240 |
8.00 |
| 3 |
253 |
8.43 |
| 4 |
268 |
8.93 |
| 5 |
247 |
8.23 |
| 6 |
243 |
8.10 |
| 7 |
281 |
9.37 |
| 8 |
248 |
8.27 |
| 9 |
224 |
7.47 |
| 10 |
242 |
8.07 |
| 11 |
262 |
8.73 |
| 12 |
257 |
8.57 |
| Total |
3000 |
100.00 |
| Autor: Grupo 3 |
# Gráfica — Porcentaje por Mes
barplot(hi,
main = "Gráfica N°9: Distribución porcentual de la contaminación
del suelo según el Mes",
xlab = "Mes (01–12)",
ylab = "%",
col = "lightgreen",
names.arg = Tabla_Mes$Mes,
las = 2,
cex.names = 0.8)
#Vamos a agrupar en 3 diferentes tipos, del 1 al 6, 7 al 9 y del 10 al 12, ya que la variable mes por si sola no se comporta como alguno de los modelos presentados.
#Gráfica 1 al 6
# Convertir Mes a numérico SOLO para el filtro
Mes_num <- as.numeric(as.character(Tabla_Mes$Mes))
# Seleccionar meses del 1 al 6
indices_1_6 <- Mes_num >= 1 & Mes_num <= 6
# Gráfica — Porcentaje por Mes (1 al 6)
barplot(hi[indices_1_6],
main = "Gráfica N°10: Distribución porcentual de la contaminación
del suelo según el Mes (1–6)",
xlab = "Mes (1–6)",
ylab = "Porcentaje",
col = "lightgreen",
names.arg = Tabla_Mes$Mes[indices_1_6],
las = 1,
cex.names = 0.8)
#Conjetura del modelo: mi variable y sus barras se comportan como el modelo de Binominal
# =========================
# MODELO BINOMIAL (1–6) — MISMO ESTILO DE LA GRÁFICA 84
# =========================
# Frecuencias reales de las clases 1 a 6
x <- ni[as.numeric(Tabla_Mes$Mes) >= 1 & as.numeric(Tabla_Mes$Mes) <= 6]
# Etiquetas (1–6)
clases <- 1:6
# Probabilidades reales
hi_1_6 <- x / sum(x)
# Variable discreta (0–5)
X <- 0:(length(x) - 1)
# Media observada
media_observada <- sum(X * x) / sum(x)
# Parámetro binomial
p <- media_observada / (length(x) - 1)
# Modelo binomial
P_binomial <- dbinom(X, size = length(x) - 1, prob = p)
# Gráfica comparativa (MISMO FORMATO)
barplot(rbind(hi_1_6, P_binomial),
beside = TRUE,
col = c("lightgreen", "blue"),
names.arg = clases,
main = "Gráfica N°XX: Modelo de probabilidad Binomial (Clases 1–6)",
ylab = "Cantidad - Probabilidad",
xlab = "Variable discreta")
legend("topright",
legend = c("Real", "Modelo"),
fill = c("lightgreen", "blue"),
cex = 0.8)
# =========================
# GRÁFICA DE CORRELACIÓN (PEARSON)
# =========================
plot(hi_1_6, P_binomial,
main = "Gráfica N°12: Correlación de frecuencias en el modelo Binomial
(Variable discreta 1–6)",
xlab = "Frecuencia Observada",
ylab = "Frecuencia Esperada",
pch = 18,
col = "darkblue")
abline(lm(P_binomial ~ hi_1_6), col = "red", lwd = 2)
# =========================
# COEFICIENTE DE CORRELACIÓN DE PEARSON
# =========================
Fo <- hi_1_6
Fe <- P_binomial
Correlacion_Pearson <- cor(Fo, Fe) * 100
Correlacion_Pearson
## [1] 85.08409
# =========================
# TEST DE CHI-CUADRADO
# Variable discreta agrupada 1–6
# =========================
# Frecuencias observadas y esperadas
Fo <- hi_1_6
Fe <- P_binomial
# Estadístico Chi-cuadrado
x2 <- sum(((Fo - Fe)^2) / Fe)
x2
## [1] 1.196262
# Valor crítico (k - 1 grados de libertad, k = 6)
vc <- qchisq(0.95, length(Fo) - 1)
vc
## [1] 11.0705
# Comparación
x2 < vc
## [1] TRUE