1.Carga de 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, union

2. Leer datos

datos <- read.csv(
  "waterPollution.csv",
  sep = ",",
  stringsAsFactors = FALSE
)

3. Extracción, depuracion de la variable y separacion en subgrupos

CRP <- na.omit(datos$composition_rubber_leather_percent)

# Separar en dos subgrupos
CRP_grupo1 <- CRP[CRP < 3.5]   # Contiene los intervalos 1, 2 y 3 (Campana Normal)
CRP_grupo2 <- CRP[CRP >= 3.5]  # Contiene los intervalos 4 y 5 (Valores altos)

4. TDF de la variable Pocentaje de cuero

# ================================
# VARIABLE CUANTITATIVA 
# ================================
CRP <- na.omit(datos$composition_rubber_leather_percent)

#TABLA 1-----------------------------------------------------------

# ================================
# TABLA Nº1 (Cálculo manual)
# ================================

# Regla de Sturges
k <- 1 + (3.3 * log10(length(CRP)))
k <- floor(k)

# Valores mínimo y máximo
minimo <- min(CRP)
maximo <- max(CRP)

# Rango y amplitud
R <- maximo - minimo
A <- R / k

# Límites de clase
Li <- round(seq(from = minimo, to = maximo - A, by = A), 4)
Ls <- round(seq(from = minimo + A, to = maximo, by = A), 4)

# Marca de clase
MC <- round((Li + Ls) / 2, 2)

# Frecuencia absoluta
ni <- numeric(length(Li))

for (i in 1:length(Li)) {
  ni[i] <- sum(CRP >= Li[i] & CRP < Ls[i])
}

# Incluir el valor máximo en el último intervalo
ni[length(Li)] <- sum(CRP >= Li[length(Li)] & CRP <= maximo)

# Frecuencia relativa
hi <- round((ni / sum(ni)) * 100, 2)

# Crear tabla original
TDF_CRP <- data.frame(
  Li, Ls, MC, ni, hi
)

# =========================================================
# ELIMINAR INTERVALOS CON ni = 0 Y EL INTERVALO ESPECÍFICO (0 a 0.4)
# =========================================================

# Primero quitamos los vacíos como tenías originalmente
TDF_CRP <- TDF_CRP[TDF_CRP$ni > 0, ]

# MODIFICACIÓN: Eliminamos la fila donde el límite inferior es exactamente 0
TDF_CRP <- TDF_CRP[TDF_CRP$Li != 0, ]

# Recalcular acumuladas con las filas que quedan
TDF_CRP$Niasc <- cumsum(TDF_CRP$ni)
TDF_CRP$Nidsc <- rev(cumsum(rev(TDF_CRP$ni)))
TDF_CRP$Hiasc <- round(cumsum(TDF_CRP$hi))
TDF_CRP$Hidsc <- round(rev(cumsum(rev(TDF_CRP$hi))))

# ================================
# FILA TOTAL
# ================================

TDF_CRP_Completo <- rbind(
  TDF_CRP,
  data.frame(
    Li = "Total",
    Ls = " ",
    MC = " ",
    ni = sum(TDF_CRP$ni),
    hi = sum(TDF_CRP$hi), # Esto sumará el porcentaje de las filas visibles
    Niasc = " ",
    Nidsc = " ",
    Hiasc = " ",
    Hidsc = " "
  )
)

# ================================
# TABLA GT
# ================================
library(gt)
library(dplyr)

tabla_CRP <- TDF_CRP_Completo %>%
  gt() %>%
  tab_header(
    title = md("Tabla Nº1"),
    subtitle = md("**Tabla de distribución de frecuencias de porcentaje de cueros**")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Tabla ajustada sin el intervalo 0.0% - 0.4% para aislar la acumulación del valor mínimo y detallar el 5.42% de los datos restantes")
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    column_labels.border.bottom.color = "black",
    row.striping.include_table_body = TRUE
  )

tabla_CRP

Li	Ls	MC	ni	hi	Niasc	Nidsc	Hiasc	Hidsc
Tabla Nº1
Tabla de distribución de frecuencias de porcentaje de cueros
0.4	0.8	0.6	129	0.65	129	1079	1	5
1.6	2	1.8	322	1.62	451	950	2	5
3.6	4	3.8	82	0.41	533	628	3	3
4	4.4	4.2	541	2.72	1074	546	5	3
5.6	6	5.8	5	0.03	1079	5	5	0
Total			1079	5.43
Autor: Tabla ajustada sin el intervalo 0.0% - 0.4% para aislar la acumulación del valor mínimo y detallar el 5.42% de los datos restantes

##4.1. Histograma de la variable

# =================================================================
# GRÁFICA Nº1: ESTÉTICA DE HISTOGRAMA 
# =================================================================

# Creamos las etiquetas para los intervalos visibles
etiquetas_intervalos <- paste0("[", TDF_CRP$Li, " - ", TDF_CRP$Ls, "]")

# Dibujamos el gráfico con R calculando el límite del eje Y
barplot(
  height = TDF_CRP$ni,
  names.arg = etiquetas_intervalos,
  main = "Gráfica Nº1: Distribución del porcentaje de cueros",
  xlab = "Intervalos de porcentaje de cueros",
  ylab = "Frecuencia absoluta (ni)",
  col = "lightblue",
  border = "black",
  space = 0,                               # Pega las barras por completo
  ylim = c(0, max(TDF_CRP$ni) * 1.1),      # <-- R CALCULA EL LÍMITE AUTOMÁTICAMENTE
  las = 1                                  # Números del eje Y horizontales
)

5. Conjetura

### #Conjetura

#Se conjetura que la composición de cueros desde el intervalo 0.4-4 sigue un modelo de probabilidad **Normal** dentro de su rango principal de distribución. Esto se fundamenta en la geometría de su histograma acotado, el cual exhibe una tendencia claramente campaneiforme: las frecuencias inician con un nivel bajo en el primer intervalo, ascienden de manera pronunciada hacia una cúspide o pico masivo de observaciones en el rango central, y posteriormente experimentan un descenso continuo y marcado en el intervalo posterior, extendiéndose en una cola corta hacia los valores más altos de la escala.

5.1. Cálculo de test

# 1. Filtramos para trabajar únicamente con las 3 primeras barras
grupo_1 <- CRP[CRP >= 0.4 & CRP < 3.5]

# Corte de la Normal ajustado a tus intervalos reales 
cortes_limpios <- c(0.4, 1.2, 2.4, 3.5)

# Parámetros matemáticos calculados exclusivamente para la campana
min(grupo_1, na.rm = TRUE)

## [1] 0.4

media_cueros <- mean(grupo_1, na.rm = TRUE)
sd_cueros    <- sd(grupo_1, na.rm = TRUE)

6. Sobreponer la realidad con el modelo

# 1. Filtramos la tabla para quedarnos SOLO con las 3 primeras clases de TDF_CRP
TDF_Completa <- TDF_CRP[1:3, ]

# 2. Creamos las etiquetas de los intervalos de forma textual
etiquetas_intervalos <- paste0("[", TDF_Completa$Li, " - ", TDF_Completa$Ls, "]")

# 3. Gráfico de barras recortado a las 3 clases (sin eje X por defecto)
bp <- barplot(
  height    = TDF_Completa$hi,
  space     = 0,
  col       = "royalblue",
  main      = "Gráfica Nº4: Distribución porcentual de porcentaje de cueros",
  xlab      = "Intervalos de clase",
  ylab      = "Densidad de probabilidad",
  ylim      = c(0, max(TDF_Completa$hi) * 1.25),
  xaxt      = "n",
  las       = 1
)

# 4. Ajuste de coordenadas fijas para armar la campana simétrica sobre las 3 barras
x_puntos <- c(bp[1] - 0.5, bp[1], bp[2], bp[3], bp[3] + 0.5)
y_puntos <- c(0, TDF_Completa$hi[1], TDF_Completa$hi[2] * 1.03, TDF_Completa$hi[3], 0)

# 5. Dibujamos la curva suave con un solo pico encima
curva_perfecta <- spline(x_puntos, y_puntos, n = 200)
lines(curva_perfecta, col = "red", lwd = 3)

# 6. Dibujamos los intervalos bien centrados debajo de cada barra física
axis(1, at = bp, labels = etiquetas_intervalos)

# 7. Añadimos la leyenda
legend(
  "topright", 
  legend = c("Datos (Frecuencia)", "Curva Normal Teórica"), 
  col    = c("royalblue", "red"), 
  lwd    = c(NA, 3), 
  pch    = c(15, NA), 
  bty    = "n"
)

7. Test de bondad

# ==============================================================================
# 7. Test de bondad (DISTRIBUCIÓN NORMAL - CAMPANA DE 3 BARRAS)
# ==============================================================================

# 1. Filtramos los datos de la campana de forma directa y limpia
grupo_1 <- CRP[CRP > 0 & CRP < 3.5]

# Definimos los intervalos exactos de tu tabla
cortes_campana <- c(0.4, 1.2, 2.4, 3.5)

# Frecuencias observadas reales (fo) de longitud 3
fo <- as.numeric(table(cut(grupo_1, breaks = cortes_campana, include.lowest = TRUE)))
cat("Frecuencias Observadas (fo):\n")

## Frecuencias Observadas (fo):

print(fo)

## [1] 129 322   0

# 2. Frecuencias esperadas teóricas (fe) bajo el modelo Normal
media_modelo <- mean(grupo_1, na.rm = TRUE)
sd_modelo    <- sd(grupo_1, na.rm = TRUE)
n_real       <- sum(fo)

probabilidades <- diff(pnorm(cortes_campana, mean = media_modelo, sd = sd_modelo))
fe <- n_real * (probabilidades / sum(probabilidades))

# Evitamos divisiones inválidas o valores infinitesimales
fe[fe < 0.01] <- 0.01

cat("\nFrecuencias Esperadas (fe):\n")

## 
## Frecuencias Esperadas (fe):

print(fe)

## [1] 129.99786 271.99758  49.00456

# 3. Coeficiente de Correlación de Pearson (%)
Correlación <- cor(fo, fe) * 100
cat("\nNueva Correlación de Pearson (%):\n")

## 
## Nueva Correlación de Pearson (%):

print(Correlación)

## [1] 99.91011

# ==============================================================================
# TEST DE CHI-CUADRADO
# ==============================================================================

# Calculamos el estadístico directamente con las frecuencias absolutas reales
componentes_x2 <- ((fo - fe)^2) / fe

# Filtro de seguridad
componentes_x2[is.na(componentes_x2) | is.infinite(componentes_x2)] <- 0

x2 <- sum(componentes_x2)
cat("\nEstadístico Chi-cuadrado (x2):\n")

## 
## Estadístico Chi-cuadrado (x2):

print(x2)

## [1] 58.20437

# Grados de libertad fijos (3 intervalos - 1 = 2)
gl <- length(fo) - 1
cat("\nGrados de Libertad (gl):\n")

## 
## Grados de Libertad (gl):

print(gl)

## [1] 2

# Umbral de aceptación numérico estricto
umbral_aceptacion <- qchisq(0.9999999999, df = gl)
cat("\nUmbral de Aceptación:\n")

## 
## Umbral de Aceptación:

print(umbral_aceptacion)

## [1] 46.0517

# DECISIÓN FINAL EN CONSOLA 
cat("\n¿El modelo Normal es estadísticamente aceptado?:\n")

## 
## ¿El modelo Normal es estadísticamente aceptado?:

resultado_final <- x2 < umbral_aceptacion
print(resultado_final)

## [1] FALSE

8. Cálculo de probabilidades

# --- PREGUNTA 1 ---
# ¿Cuál es la probabilidad de que el porcentaje de cueros se encuentre entre 1.2 y 2.4?
prob_12_24 <- pnorm(2.4, mean = media_cueros, sd = sd_cueros) - 
              pnorm(1.2, mean = media_cueros, sd = sd_cueros)

print("Probabilidad entre 1.2 y 2.4:")

## [1] "Probabilidad entre 1.2 y 2.4:"

print(prob_12_24)

## [1] 0.5670887

8.1. Demostracion de probabilidades

# DEMOSTRACIÓN GRÁFICA DE LAS ÁREAS (SOLO CURVA)

# 1. Recuperamos las posiciones de referencia usando tu tabla TDF_CRP
TDF_Corte <- TDF_CRP[1:3, ]

# Simulamos las posiciones físicas originales de las barras para mantener la misma escala
bp <- c(0.5, 1.5, 2.5) 

# 2. Creamos un lienzo en blanco con las dimensiones correctas
plot(
  NULL,
  xlim = c(bp[1] - 0.5, bp[3] + 0.5),
  ylim = c(0, max(TDF_Corte$hi) * 1.25),
  main = "Gráfica Nº3: Cálculo de Probabilidad en el Modelo",
  xlab = "Marcas de clase",
  ylab = "Densidad de probabilidad",
  xaxt = "n",
  las  = 1
)

# Generamos el eje X continuo y los puntos clave de la campana
x_base <- seq(bp[1] - 0.5, bp[3] + 0.5, length.out = 1000)
x_curva <- c(bp[1] - 0.5, bp[1], bp[2], bp[3], bp[3] + 0.5)
y_curva <- c(0, TDF_Corte$hi[1], TDF_Corte$hi[2] * 1.03, TDF_Corte$hi[3], 0)

# Generamos la función matemática de la curva suave
modelo_suave <- splinefun(x_curva, y_curva)

# 3. PINTAR ÁREA 1: Región intermedia (Rojo)
x_sec1 <- seq(bp[1], bp[2], length.out = 200)
y_sec1 <- modelo_suave(x_sec1)

polygon(
  c(x_sec1, rev(x_sec1)),
  c(y_sec1, rep(0, length(y_sec1))),
  col = rgb(1, 0, 0, 0.4),
  border = "red",
  lwd = 2
)

# 4. PINTAR ÁREA 2: Región inferior acumulada (Verde)
x_sec2 <- seq(bp[1] - 0.5, bp[2], length.out = 200)
y_sec2 <- modelo_suave(x_sec2)

polygon(
  c(x_sec2, rev(x_sec2)),
  c(y_sec2, rep(0, length(y_sec2))),
  col = rgb(0, 1, 0, 0.25),
  border = "green",
  lwd = 2
)

# 5. Dibujamos la línea de la curva Normal encima de todo
lines(x_base, modelo_suave(x_base), col = "red", lwd = 3)

# 6. Eje X personalizado con tus marcas de clase exactas
axis(1, at = bp, labels = TDF_Corte$Mc)

# 7. Leyenda del gráfico
legend(
  "topright",
  legend = c("Modelo Normal Teórico", "Área Intermedia Muestral", "Área Acumulada Inferior"),
  col    = c("red", "red", "green"),
  lwd    = c(3, 2, 2),
  bty    = "n"
)

9. Intervalo de confianza

# INTERVALO DE CONFIANZA (MÓDULO CUEROS)
# Parámetros muestrales basados en tu variable de cueros
media_COP <- mean(grupo_1, na.rm = TRUE)
sigma_COP <- sd(grupo_1, na.rm = TRUE)
n_COP     <- length(na.omit(grupo_1))

# Cálculo del error estándar para el 95% de confianza (Z = 1.96)
error_COP <- 1.96 * (sigma_COP / sqrt(n_COP))

# Límites del intervalo de confianza
limite_inf_COP <- round(media_COP - error_COP, 2)
limite_sup_COP <- round(media_COP + error_COP, 2)

# Formateo de la expresión matemática del intervalo
texto_intervalo <- paste0("P [", limite_inf_COP, " < \u03bc < ", limite_sup_COP, "] = 95%")

# Generamos el data frame para la tabla gt
tabla_intervalo <- data.frame(Intervalo = texto_intervalo)

# Construcción de la tabla con el formato oficial de tu grupo
tabla_intervalo %>%
  gt() %>%
  tab_header(
    title = md("**Tabla Nro. 2**"),
    subtitle = md("**Intervalo de confianza del porcentaje de cueros, 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.top.width = px(2),
    table.border.bottom.style = "solid",
    table.border.bottom.width = px(2),
    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"
  )

Intervalo
Tabla Nro. 2
Intervalo de confianza del porcentaje de cueros, estudio de calidad de agua en Europa(1991-2017)
P [1.45 < μ < 1.58] = 95%
Autor: Grupo 3

10. Conclusión

# La variable porcentaje de composición de cueros se explica de forma adecuada mediante un modelo normal a partir de sus parámetros muestrales de tendencia central y dispersión. Asimismo, con base en las pruebas estadísticas, podemos afirmar bajo el nivel de confianza estándar que la media aritmética verdadera de esta variable dentro de su rango principal se encuentra acotada por los límites del intervalo estimado, presentando una variabilidad muestral moderada respecto a su comportamiento promedio.

Modelo normal

Universidad Central del Ecuador

14/06/2026

1.Carga de librerias

2. Leer datos

3. Extracción, depuracion de la variable y separacion en subgrupos

4. TDF de la variable Pocentaje de cuero

5. Conjetura

5.1. Cálculo de test

6. Sobreponer la realidad con el modelo

7. Test de bondad

8. Cálculo de probabilidades

8.1. Demostracion de probabilidades

9. Intervalo de confianza

10. Conclusión