Modelo log-normal
Universidad Central del Ecuador
2026-06-17
0. Librerías
# -------------------------
# Cargar librerías
# -------------------------
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, union1.Leer datos
# -------------------------
# Cargar datos
# -------------------------
datos <- read.csv("waterPollution.csv",
sep = ",",
stringsAsFactors = FALSE)2. Selección de variable aleatoria
# ================================
# VARIABLE CUANTITATIVA CONTINUA
# ================================
CPP <- na.omit(datos$composition_plastic_percent)3. Tabla de disitribución de frecuencias
# ===================================
# TABLA NB:2 ESTADÍSTICA DESCRIPTIVA
# ===================================
histoP <- hist(CPP, breaks = 10, plot = FALSE)
LimInf <- round(histoP$breaks[-length(histoP$breaks)], 0)
LimSup <- round(histoP$breaks[-1], 0)
Mc <- round(histoP$mids, 2)
ni <- histoP$counts
hi <- round((ni/sum(ni)) * 100, 2)
TDF_Histo_CGP <- data.frame(LimInf, LimSup, Mc, ni, hi)
TDF_Histo_CGP <- TDF_Histo_CGP[TDF_Histo_CGP$ni > 0, ]
TDF_Histo_CGP$Ni_asc <- cumsum(TDF_Histo_CGP$ni)
TDF_Histo_CGP$Ni_dsc <- rev(cumsum(rev(TDF_Histo_CGP$ni)))
TDF_Histo_CGP$Hi_asc <- round(cumsum(TDF_Histo_CGP$hi), 2)
TDF_Histo_CGP$Hi_dsc <- round(rev(cumsum(rev(TDF_Histo_CGP$hi))), 2)
TDF_Histo_CGP_Completo <- rbind(
TDF_Histo_CGP,
data.frame(
LimInf = "Total", LimSup = " ", Mc = " ",
ni = sum(TDF_Histo_CGP$ni), hi = 100,
Ni_asc = " ", Ni_dsc = " ", Hi_asc = " ", Hi_dsc = " "
)
)
tabla_Histo_CGP <- TDF_Histo_CGP_Completo %>%
gt() %>%
tab_header(
title = md("*Tabla Nº1*"),
subtitle = md("**Distribución de frecuencia simplificada de porcentaje de plástico en el estudio de calidad de agua en Europa (1991-2017)**")
) %>%
tab_source_note(source_note = md("Autor: Grupo 3, "))
tabla_Histo_CGP| Tabla Nº1 | ||||||||
| Distribución de frecuencia simplificada de porcentaje de plástico en el estudio de calidad de agua en Europa (1991-2017) | ||||||||
| LimInf | LimSup | Mc | ni | hi | Ni_asc | Ni_dsc | Hi_asc | Hi_dsc |
|---|---|---|---|---|---|---|---|---|
| 0 | 2 | 1 | 437 | 2.20 | 437 | 19893 | 2.2 | 100 |
| 2 | 4 | 3 | 506 | 2.54 | 943 | 19456 | 4.74 | 97.8 |
| 6 | 8 | 7 | 256 | 1.29 | 1199 | 18950 | 6.03 | 95.26 |
| 8 | 10 | 9 | 12802 | 64.35 | 14001 | 18694 | 70.38 | 93.97 |
| 10 | 12 | 11 | 460 | 2.31 | 14461 | 5892 | 72.69 | 29.62 |
| 12 | 14 | 13 | 1419 | 7.13 | 15880 | 5432 | 79.82 | 27.31 |
| 14 | 16 | 15 | 22 | 0.11 | 15902 | 4013 | 79.93 | 20.18 |
| 16 | 18 | 17 | 15 | 0.08 | 15917 | 3991 | 80.01 | 20.07 |
| 20 | 22 | 21 | 3957 | 19.89 | 19874 | 3976 | 99.9 | 19.99 |
| 22 | 24 | 23 | 19 | 0.10 | 19893 | 19 | 100 | 0.1 |
| Total | 19893 | 100.00 | ||||||
| Autor: Grupo 3, | ||||||||
4. Gráfica de distribución de frecuencias
# ===========================================
# GRÁFICA Nº4: Distribución porcentual (hi)
# ===========================================
bp <- barplot(TDF_Histo_CGP$hi,
col = "royalblue",
space = 0 ,
main = "Gráfica Nº1: Distribución de frecuencia simplificada de
porcentaje de plástico en el estudio de calidad de agua en
Europa (1991-2017)",
xlab = "Porcentaje de plástico (%)",
cex.names = 0.7 ,
ylab = "Porcentaje (%)",
names.arg = paste(TDF_Histo_CGP$LimInf, "-", TDF_Histo_CGP$LimSup))
5. Conjetura
Se conjetura que el porcentaje de contaminación por plástico sigue un modelo de probabilidad log-normal dentro de su rango principal de distribución. Esto se fundamenta en que el histograma de la variable acotada presenta una marcada asimetría positiva, caracterizada por un ascenso abrupto hacia un pico masivo de observaciones en el intervalo de 8–10% y un posterior descenso continuo que se extiende en una cola larga hacia valores más altos (12% a 18%), comportamiento típico de variables ambientales con límites estrictos en cero y sesgo a la derecha.
6. Cálculo de parámetros
# ================================================
# CÁLCULO DE PARÁMETROS DISTRIBUCIÓN EXPONENCIAL
# ================================================
# Corte de Lognormal
CPP_recortado <- CPP[CPP >= 6 & CPP <= 18]
# Parámetros matemáticos del modelo
min_val <- min(CPP_recortado)
log_CPP <- log(CPP_recortado)
mulog_CPP <- mean(log_CPP)
sigmalog_CPP <- sd(log_CPP)
# Imprimir los parámetros para que se vean en pantalla
print("Mínimo del recorte:")## [1] "Mínimo del recorte:"print(min_val)## [1] 6.58print("Parámetro mulog_CPP (Media logarítmica):")## [1] "Parámetro mulog_CPP (Media logarítmica):"print(mulog_CPP)## [1] 2.233402print("Parámetro sigmalog_CPP (Desviación estándar logarítmica):")## [1] "Parámetro sigmalog_CPP (Desviación estándar logarítmica):"print(sigmalog_CPP)## [1] 0.11904977. Sobreposición de la realidad con el modelo
breaks_recortado <- seq(6, 18, by = 2)
hist(
CPP_recortado,
breaks = breaks_recortado,
col = "skyblue",
freq = FALSE,
main = "Gráfica N°2: Comparación de la Realidad y el Modelo Log-normal\ndel Porcentaje de Plástico",
xlab = "Porcentaje de plástico (%)",
ylab = "Densidad de probabilidad",
cex.main = 0.9,
ylim = c(0, 0.45)
)
#La curva Lognormal
curve(
dlnorm(x, meanlog = mulog_CPP, sdlog = sigmalog_CPP),
from = 6,
to = 18,
col = "darkblue",
lwd = 3,
add = TRUE
)
8. Test de bondad
8.1 Test de pearson
# 1. Definimos los cortes exactos (del 6 al 18, de 2 en 2)
breaks_test <- seq(6, 18, by = 2)
# Frecuencias observadas
fo <- hist(CPP_recortado, breaks = breaks_test, plot = FALSE)$counts
n <- length(CPP_recortado)
# Frecuencias esperadas
fe <- numeric(length(fo))
for(i in 1:length(fo)){
fe[i] <- n * (plnorm(breaks_test[i + 1], meanlog = mulog_CPP, sdlog = sigmalog_CPP) -
plnorm(breaks_test[i], meanlog = mulog_CPP, sdlog = sigmalog_CPP))
}
# Correlación de Pearson (%)
Correlación <- cor(fo, fe) * 100
cat("Correlación de Pearson (%):", Correlación, "\n\n")## Correlación de Pearson (%): 90.76858.2 Test Chi-cuadrado
# ==========================================
# TEST DE CHI-CUADRADO (Formato final)
# ==========================================
# Frecuencias relativas para Chi-cuadrado
fe_frac <- fe / n
fo_frac <- fo / n
# Estadístico Chi-cuadrado
x2 <- sum((fo_frac - fe_frac)^2 / fe_frac)
# Grados de libertad y umbral de aceptación
k <- length(fo_frac)
gl <- k - 1 - 2
umbral_aceptacion <- qchisq(0.95, df = gl)
cat("Estadístico Chi-cuadrado (Calculado):", x2, "\n")## Estadístico Chi-cuadrado (Calculado): 1.0586cat("Valor crítico (Umbral de aceptación):", umbral_aceptacion, "\n")## Valor crítico (Umbral de aceptación): 7.814728cat("¿Aprueba el test?:", x2 < umbral_aceptacion, "\n")## ¿Aprueba el test?: TRUE9. Cálculo de Probabilidades
1.¿Cuál es la probabilidad de que el porcentaje de plástico en los cuerpos de agua en Europa se encuentre entre el 8% y el 11%?
prob_8_11 <- plnorm(11, meanlog = mulog_CPP, sdlog = sigmalog_CPP) -
plnorm(8, meanlog = mulog_CPP, sdlog = sigmalog_CPP)
print(prob_8_11)## [1] 0.81850792.Si se analizan 200 muestras de cuerpos de agua, ¿cuántas se espera que tengan una composición de plasticos superior al 8%?
# Definimos el tamaño de la nueva muestra analizada
n_muestras_agua <- 200
# Calculamos la probabilidad de tener más del 8% de plásticos (1 - P(X <= 8))
prob_mayor_8 <- 1 - plnorm(8, meanlog = mulog_CPP, sdlog = sigmalog_CPP)
# Calculamos la cantidad esperada de muestras
esperadas_8 <- prob_mayor_8 * n_muestras_agua
cat("Cantidad esperada de muestras:", round(esperadas_8, 0), "\n")## Cantidad esperada de muestras: 180# DEMOSTRACIÓN GRÁFICA: Ambas probabilidades en una sola gráfica
x_base <- seq(6, 18, by = 0.001)
plot(
x_base, dlnorm(x_base, meanlog = mulog_CPP, sdlog = sigmalog_CPP),
col = "skyblue3",
lwd = 3,
xlim = c(6, 18),
ylim = c(0, 0.45),
main = "Gráfica: Áreas de Probabilidad del Modelo",
ylab = "Densidad de probabilidad",
xlab = "Porcentaje de plástico (%)",
xaxt = "n"
)
# PINTAR ÁREA 1: Entre 8% y 11% (Rojo)
x_sec1 <- seq(8, 11, by = 0.001)
y_sec1_valores <- dlnorm(x_sec1, meanlog = mulog_CPP, sdlog = sigmalog_CPP)
lines(x_sec1, y_sec1_valores, col = "red", lwd = 2)
polygon(
c(x_sec1, rev(x_sec1)),
c(y_sec1_valores, rep(0, length(y_sec1_valores))),
col = rgb(1, 0, 0, 0.4)
)
# PINTAR ÁREA 2: Mayor a 8% (Naranja)
x_sec2 <- seq(8, 18, by = 0.001)
y_sec2_valores <- dlnorm(x_sec2, meanlog = mulog_CPP, sdlog = sigmalog_CPP)
lines(x_sec2, y_sec2_valores, col = "orange", lwd = 2)
polygon(
c(x_sec2, rev(x_sec2)),
c(y_sec2_valores, rep(0, length(y_sec2_valores))),
col = rgb(1, 0.65, 0, 0.3)
)
# Leyenda con ambas zonas
legend(
"topright",
legend = c("Modelo Lognormal", "Prob. (8% a 11%)", "Área > 8% (Muestras)"),
col = c("skyblue3", "red", "orange"),
lwd = 3,
bty = "n"
)
axis(1, at = seq(6, 18, by = 1), labels = seq(6, 18, by = 1), las = 1)
10. Intervalo de Confianza
# ==============================
# #INTERVALO DE CONFIANZA
# ==============================
# (rango 6 a 18)
media_CPP <- mean(CPP_recortado)
sigma_CPP <- sd(CPP_recortado)
n_CPP <- length(CPP_recortado)
# Cálculo del error estándar para el 95% de confianza (Z ≈ 1.96)
error_CPP <- 2 * (sigma_CPP / sqrt(n_CPP))
# Límites del intervalo de confianza
limite_inf_CPP <- round(media_CPP - error_CPP, 2)
limite_sup_CPP <- round(media_CPP + error_CPP, 2)
texto_intervalo <- paste0("P [", limite_inf_CPP, " < µ < ", limite_sup_CPP, "] = 95%")
# Generamos el data frame para la tabla gt
tabla_intervalo <- data.frame(Intervalo = texto_intervalo)
# Construcción de la tabla con el formato de tu grupo
tabla_intervalo %>%
gt() %>%
tab_header(
title = md("*Tabla Nro. 2*"),
subtitle = md("**Intervalo de confianza del porcentaje de plástico, estudio de calidad de agua en Europa(1991-2017)**")
) %>%
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"
)| Tabla Nro. 2 |
| Intervalo de confianza del porcentaje de plástico, estudio de calidad de agua en Europa(1991-2017) |
| Intervalo |
|---|
| P [9.38 < µ < 9.42] = 95% |
| Autor: Grupo 3 |
11. Conclusión
La variable porcentaje de contaminación por plástico (%) se explica de forma óptima mediante un modelo log-normal con parámetros μlog = 2.23 y σlog = 0.11. Asimismo, con base en las pruebas estadísticas, podemos afirmar con un 95% de confianza que la media aritmética poblacional de esta variable dentro del rango principal se encuentra entre 9.38% y 9.42%, presentando una desviación estándar de 1.27%.