Porcentaje de Plástico, Distribución Log-Normal
Universidad Central del Ecuador
2026-06-17
1.Librerias
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, unionlibrary(e1071)
library(fitdistrplus)## Cargando paquete requerido: MASS##
## Adjuntando el paquete: 'MASS'## The following object is masked from 'package:dplyr':
##
## select## Cargando paquete requerido: survival2.Leer Datos
datos <- read.csv("waterPollution.csv",
sep = ",",
stringsAsFactors = FALSE)3.Extracción y depuración de la variable
CPP <- na.omit(datos$composition_plastic_percent)4.TDF de la variable Pocentaje de plástico
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.1 Histograma de la variable
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))
text(bp, TDF_Histo_CGP$hi, round(TDF_Histo_CGP$hi, 2), pos = 3, cex = 0.8)
5.Conjetura
#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.5.1 Calculo de prob
#Corte de Lognormal
CPP_recortado <- CPP[CPP >= 6 & CPP <= 18]
#Parámetros matemáticos del modelo
min(CPP_recortado)## [1] 6.58log_CPP <- log(CPP_recortado)
mulog_CPP <- mean(log_CPP)
sigmalog_CPP <- sd(log_CPP)6.Sobreponer la realidad con el modelo
#Histograma
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
)
7.Test de bondad
# 1. Definimos los cortes exactos que usamos en tu gráfica (del 6 al 18, de 2 en 2)
breaks_test <- seq(6, 18, by = 2)
# Frecuencias observadas (fo)
fo <- hist(CPP_recortado, breaks = breaks_test, plot = FALSE)$counts
print("Frecuencias Observadas:")## [1] "Frecuencias Observadas:"print(fo)## [1] 256 12802 460 1419 22 15n <- length(CPP_recortado)
# Vector vacío para frecuencias esperadas (fe)
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))
}
print("Frecuencias Esperadas:")## [1] "Frecuencias Esperadas:"print(fe)## [1] 1.465341e+03 9.305730e+03 3.942062e+03 2.544033e+02 4.865236e+00
## [6] 4.409651e-02#Correlación de Pearson (%)
Correlación <- cor(fo, fe) * 100
print("Correlación de Pearson (%):")## [1] "Correlación de Pearson (%):"print(Correlación)## [1] 90.7685# TEST DE CHI-CUADRADO
# Frecuencias relativas esperadas
fe_frac <- fe / n
print("Frecuencias Relativas Esperadas:")## [1] "Frecuencias Relativas Esperadas:"print(fe_frac)## [1] 9.785904e-02 6.214592e-01 2.632604e-01 1.698967e-02 3.249123e-04
## [6] 2.944872e-06# Frecuencias relativas observadas
fo_frac <- fo / n
print("Frecuencias Relativas Observadas:")## [1] "Frecuencias Relativas Observadas:"print(fo_frac)## [1] 0.017096300 0.854948578 0.030719915 0.094764258 0.001469213 0.001001736# Estadístico Chi-cuadrado
x2 <- sum((fo_frac - fe_frac)^2 / fe_frac)
print("Estadístico Chi-cuadrado (X2):")## [1] "Estadístico Chi-cuadrado (X2):"print(x2)## [1] 1.0586# Grados de libertad (k = número de intervalos)
# Se restan los 2 parámetros estimados (mulog y sigmalog) y el -1 de cajón
k <- length(fo_frac)
gl <- k - 1 - 2
print("Grados de Libertad:")## [1] "Grados de Libertad:"print(gl)## [1] 3# Umbral de aceptación
umbral_aceptacion <- qchisq(0.9999999999, df = gl)
print("Umbral de Aceptación:")## [1] "Umbral de Aceptación:"print(umbral_aceptacion)## [1] 49.54216# ¿Se acepta el modelo lognormal? (TRUE = Sí, FALSE = No)
print("¿El estadístico es menor que el umbral? (Veredicto):")## [1] "¿El estadístico es menor que el umbral? (Veredicto):"print(x2 < umbral_aceptacion)## [1] TRUE8.Calculo de probabilidades
# --- PREGUNTA 1 ---
# ¿Cuál es la probabilidad de que el porcentaje de plástico se encuentre entre 8% y 11%?
prob_8_11 <- plnorm(11, meanlog = mulog_CPP, sdlog = sigmalog_CPP) -
plnorm(8, meanlog = mulog_CPP, sdlog = sigmalog_CPP)
print("Probabilidad entre 8% y 11%:")## [1] "Probabilidad entre 8% y 11%:"print(prob_8_11)## [1] 0.8185079# --- PREGUNTA 2 ---
# ¿Cuál es la probabilidad de que el porcentaje de plástico no supere el 10%?
prob_menos_10 <- plnorm(10, meanlog = mulog_CPP, sdlog = sigmalog_CPP)
print("Probabilidad de que no supere el 10%:")## [1] "Probabilidad de que no supere el 10%:"print(prob_menos_10)## [1] 0.7194228.1 Demostración De la probabilidad
# DEMOSTRACIÓN GRÁFICA DE LAS ÁREAS
# Eje X base para el dibujo del modelo completo (de 6 a 18)
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 N°3: Cálculo de Probabilidad en el 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: Desde 6% hasta 10% (Verde)
x_sec2 <- seq(6, 10, by = 0.001)
y_sec2_valores <- dlnorm(x_sec2, meanlog = mulog_CPP, sdlog = sigmalog_CPP)
lines(x_sec2, y_sec2_valores, col = "green", lwd = 2)
polygon(
c(x_sec2, rev(x_sec2)),
c(y_sec2_valores, rep(0, length(y_sec2_valores))),
col = rgb(0, 1, 0, 0.3)
)
legend(
"topright",
legend = c("Modelo Lognormal", "Área [8% - 11%]", "Área [<= 10%]"),
col = c("skyblue3", "red", "green"),
lwd = 3,
bty = "n"
)
axis(1, at = seq(6, 18, by = 1), labels = seq(6, 18, by = 1), las = 1)
9.Intervalo de confianza
#INTERVALO DE CONFIANZA (MÓDULO PLÁSTICOS)
# (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 |
10. Conclusión
La variable porcentaje de contaminación por plástico (%) se explica de forma óptima mediante un modelo log-normal con parámetros \(\mu_{\log}\) = 2.23 y \(\sigma_{\log}\) = 0.12. Asimismo, con base en las pruebas estadísticas, podemos afirmar con un 95% de confianza que la media aritmética verdadera de esta variable dentro del rango principal se encuentra entre 9.38% y 9.42%, presentando una desviación estándar muestral de 1.27%.