1. CARGA DE DATOS Y LIBRERÍAS

datos <- read.csv(
  "C:/Users/Grace/Downloads/dataset_geologico_limpio_80.csv",
  header = TRUE,
  sep = ",",
  dec = "."
)

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(knitr)
library(gt)
library(moments)

2. SELECCIÓN DE LA VARIABLE

# Extraer la variable.
arcilla <- as.numeric(datos$CLAY_PCT)
arcilla <- na.omit(arcilla)

# Conservar únicamente porcentajes positivos.
arcilla <- arcilla[arcilla > 0]

# Identificar y separar los valores atípicos.
caja <- boxplot(arcilla, plot = FALSE)
limite_inf <- caja$stats[1]
limite_sup <- caja$stats[5]

arcilla_outliers <- arcilla[
  arcilla < limite_inf | arcilla > limite_sup
]
arcilla_sin_outliers <- arcilla[
  arcilla >= limite_inf & arcilla <= limite_sup
]

cat("Cantidad con valores atípicos:", length(arcilla), "\n")
## Cantidad con valores atípicos: 25966
cat("Cantidad de valores atípicos:", length(arcilla_outliers), "\n")
## Cantidad de valores atípicos: 1084
cat("Cantidad sin valores atípicos:", length(arcilla_sin_outliers), "\n")
## Cantidad sin valores atípicos: 24882

La variable CLAY_PCT representa el porcentaje de arcilla presente en cada muestra de sedimento marino. Para el análisis se conservan únicamente los valores positivos, debido a que un porcentaje de arcilla no puede ser negativo. Asimismo, los valores atípicos se separan para evitar que observaciones extremas distorsionen la forma general de la distribución y la estimación del modelo.

3. TABLA DE DISTRIBUCIÓN DE CANTIDAD

# Histograma utilizado como base de la tabla.
histograma_tabla <- hist(
  arcilla_sin_outliers,
  breaks = 6,
  plot = FALSE
)

ni <- histograma_tabla$counts
hi <- ni / sum(ni) * 100

intervalos <- paste0(
  "[",
  round(
    histograma_tabla$breaks[-length(histograma_tabla$breaks)],
    2
  ),
  ", ",
  round(histograma_tabla$breaks[-1], 2),
  ")"
)

tabla_frecuencias <- data.frame(
  Intervalo = intervalos,
  ni = ni,
  hi = round(hi, 2)
)

tabla_frecuencias_total <- bind_rows(
  tabla_frecuencias,
  data.frame(
    Intervalo = "TOTAL",
    ni = sum(tabla_frecuencias$ni),
    hi = 100
  )
)

tabla_arcilla_gt <- tabla_frecuencias_total %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N.° 1**"),
    subtitle = md(
      "**Distribución de frecuencias de los Sedimentos Marinos que contienen Arcilla**"
    )
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 2")
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black",
    row.striping.include_table_body = TRUE
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(
      rows = Intervalo == "TOTAL"
    )
  )

tabla_arcilla_gt
Tabla N.° 1
Distribución de frecuencias de los Sedimentos Marinos que contienen Arcilla
Intervalo ni hi
[0, 10) 14602 58.68
[10, 20) 3849 15.47
[20, 30) 2475 9.95
[30, 40) 2072 8.33
[40, 50) 1285 5.16
[50, 60) 599 2.41
TOTAL 24882 100.00
Autor: Grupo 2

4. GRÁFICA DE DISTRIBUCIÓN DE CANTIDAD

hist(
  arcilla_sin_outliers,
  breaks = 6,
  freq = TRUE,
  main = paste(
    "Gráfica 1. Distribución de cantidad de arcilla",
    "en Sedimentos Marinos"
  ),
  xlab = "Arcilla (%)",
  ylab = "Cantidad",
  col = "skyblue"
)

5. CONJETURA DEL MODELO

En el histograma se observa que las mayores frecuencias se concentran en los porcentajes bajos de arcilla y disminuyen conforme aumenta el contenido de esta variable. Este comportamiento presenta una concentración inicial seguida de un descenso progresivo hacia la derecha, semejante a la forma de una distribución exponencial. Por esta razón, se plantea como conjetura que la variable CLAY_PCT puede ajustarse a un modelo exponencial.

6. CÁLCULO DE PARÁMETROS

media <- mean(arcilla_sin_outliers)
lambda <- 1 / media

cat("Media aritmética:", round(media, 2), "\n")
## Media aritmética: 12.52
cat("Parámetro lambda:", round(lambda, 4), "\n")
## Parámetro lambda: 0.0799
cat("Tamaño de la muestra:", length(arcilla_sin_outliers), "\n")
## Tamaño de la muestra: 24882

La media representa el contenido promedio de arcilla en las muestras analizadas. En el modelo exponencial, el parámetro \(\lambda=1/\bar{x}\) representa la tasa asociada con la disminución de la densidad de probabilidad conforme aumenta el porcentaje de arcilla.

7. REALIDAD Y MODELO

# Histograma de densidad: realidad observada.
histograma <- hist(
  arcilla_sin_outliers,
  breaks = 6,
  freq = FALSE,
  main = paste(
    "Gráfica 2. Comparación de la realidad con 
    el modelo exponencial de Arcilla"
    
  ),
  xlab = "Arcilla (%)",
  ylab = "Densidad de probabilidad",
  col = "skyblue",
  border = "black"
)

# Curva exponencial: modelo teórico.
x_modelo <- seq(
  min(arcilla_sin_outliers),
  max(arcilla_sin_outliers),
  by = 0.01
)
lines(
  x_modelo,
  dexp(x_modelo, rate = lambda),
  col = "red",
  lwd = 3
)

legend(
  "topright",
  legend = c("Realidad observada", "Modelo exponencial"),
  fill = c("lightblue", NA),
  border = c("black", NA),
  lty = c(NA, 1),
  col = c(NA, "red"),
  lwd = c(NA, 3),
  bty = "n"
)

# Frecuencias observadas.
Fo <- histograma$counts

# Frecuencias esperadas.
h <- length(histograma$counts)
P <- numeric(h)

for (i in 1:h) {
  P[i] <- pexp(
    histograma$breaks[i + 1],
    rate = lambda
  ) - pexp(
    histograma$breaks[i],
    rate = lambda
  )
}

Fe <- P * length(arcilla_sin_outliers)

cat("Frecuencias observadas:\n")
## Frecuencias observadas:
print(Fo)
## [1] 14602  3849  2475  2072  1285   599
cat("Frecuencias esperadas:\n")
## Frecuencias esperadas:
print(round(Fe, 2))
## [1] 13689.32  6157.87  2770.00  1246.03   560.50   252.13

8. TESTS DE APROBACIÓN

# Test de Pearson.
n <- length(arcilla_sin_outliers)

Fo_porcentaje <- (Fo / n) * 100
Fe_porcentaje <- (Fe / n) * 100

plot(
  Fo_porcentaje,
  Fe_porcentaje,
  main = paste(
    "Gráfica 3: Correlación de frecuencias",
    "en el modelo exponencial (Arcilla)"
  ),
  xlab = "Frecuencia observada (%)",
  ylab = "Frecuencia esperada (%)",
  pch = 19,
  col = "blue3"
)
abline(a = 0, b = 1, col = "red", lwd = 2)

Correlacion <- cor(Fo_porcentaje, Fe_porcentaje) * 100

# Test de chi-cuadrado, conservando el procedimiento original.
gl <- length(histograma$counts) - 1
x2 <- sum(
  (Fe_porcentaje - Fo_porcentaje)^2 / Fe_porcentaje
)
umbral <- qchisq(0.97, gl)

decision_pearson <- ifelse(
  Correlacion >= 70,
  "APRUEBA",
  "NO APRUEBA"
)
decision_chi <- ifelse(
  x2 < umbral,
  "APRUEBA",
  "NO APRUEBA"
)

cat("Correlación de Pearson:", round(Correlacion, 2), "%\n")
## Correlación de Pearson: 97.21 %
cat("Estadístico chi-cuadrado:", round(x2, 4), "\n")
## Estadístico chi-cuadrado: 11.7321
cat("Umbral de aceptación:", round(umbral, 4), "\n")
## Umbral de aceptación: 12.3746
tabla_resumen <- data.frame(
  Prueba = c("Correlación de Pearson", "Chi-cuadrado"),
  Resultado = c(
    paste0(round(Correlacion, 2), " %"),
    paste0(
      "X² = ", round(x2, 4),
      "; umbral = ", round(umbral, 4)
    )
  ),
  Criterio = c(
    "Aprueba si Pearson >= 70 %",
    "Aprueba si X² < umbral"
  ),
  Decisión = c(decision_pearson, decision_chi)
)

tabla_resumen %>%
  gt() %>%
  tab_header(
    title = md("**Tabla resumen de los tests de aprobación**"),
    subtitle = "Evaluación del ajuste al modelo exponencial"
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(columns = Decisión)
  )
Tabla resumen de los tests de aprobación
Evaluación del ajuste al modelo exponencial
Prueba Resultado Criterio Decisión
Correlación de Pearson 97.21 % Aprueba si Pearson >= 70 % APRUEBA
Chi-cuadrado X² = 11.7321; umbral = 12.3746 Aprueba si X² < umbral APRUEBA

9. CÁLCULO DE PROBABILIDADES

¿Cuál es la probabilidad de que el porcentaje de arcilla se encuentre entre el 10 % y el 30 %?

probabilidad_arcilla <- pexp(30, rate = lambda) -
  pexp(10, rate = lambda)

cat(
  "Probabilidad entre 10 % y 30 %:",
  round(probabilidad_arcilla * 100, 2),
  "%\n"
)
## Probabilidad entre 10 % y 30 %: 35.88 %
x_probabilidad <- seq(
  min(arcilla_sin_outliers),
  max(arcilla_sin_outliers),
  by = 0.01
)

plot(
  x_probabilidad,
  dexp(x_probabilidad, rate = lambda),
  col = "skyblue3",
  lwd = 2,
  type = "l",
  main = paste(
    "Gráfica 4. Cálculo de probabilidades",
    "del contenido de Arcilla"
  ),
  ylab = "Densidad de probabilidad",
  xlab = "Arcilla (%)"
)

x_area <- seq(10, 30, by = 0.01)
y_area <- dexp(x_area, rate = lambda)

polygon(
  c(x_area, rev(x_area)),
  c(y_area, rep(0, length(y_area))),
  col = rgb(1, 0, 0, 0.5),
  border = NA
)
lines(x_area, y_area, col = "red", lwd = 2)

legend(
  "topright",
  legend = c("Modelo exponencial", "Área de probabilidad"),
  col = c("skyblue3", "red"),
  lwd = 2,
  cex = 0.7
)

texto_prob <- paste0(
  "Probabilidad = ",
  round(probabilidad_arcilla * 100, 2),
  " %"
)

text(
  x = max(arcilla_sin_outliers) * 0.6,
  y = max(dexp(x_probabilidad, rate = lambda)) * 0.7,
  labels = texto_prob,
  col = "black",
  cex = 0.9,
  font = 2
)

Si se analizan 300 nuevas muestras de sedimentos marinos, ¿cuántas se esperaría que presenten un contenido de arcilla entre el 10 % y el 30 %?

cantidad_muestras <- probabilidad_arcilla * 300

cat(
  "Cantidad esperada de muestras:",
  round(cantidad_muestras),
  "\n"
)
## Cantidad esperada de muestras: 108

10. INTERVALOS DE CONFIANZA

media_ic <- mean(arcilla_sin_outliers)
sigma <- sd(arcilla_sin_outliers)
n <- length(arcilla_sin_outliers)

e <- sigma / sqrt(n)
li <- media_ic - 2 * e
ls <- media_ic + 2 * e

cat("Media:", round(media_ic, 2), "\n")
## Media: 12.52
cat("Desviación estándar:", round(sigma, 2), "\n")
## Desviación estándar: 14.84
cat("Tamaño muestral:", n, "\n")
## Tamaño muestral: 24882
cat("Error estándar:", round(e, 4), "\n")
## Error estándar: 0.0941
cat("Límite inferior:", round(li, 2), "\n")
## Límite inferior: 12.33
cat("Límite superior:", round(ls, 2), "\n")
## Límite superior: 12.71
tabla_media <- data.frame(
  "Límite inferior" = round(li, 2),
  "Media poblacional" = round(media_ic, 2),
  "Límite superior" = round(ls, 2),
  "Error estándar" = round(e, 4),
  check.names = FALSE
)

tabla_media_gt <- tabla_media %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N.° 3**"),
    subtitle = md(
      "**Intervalo de confianza del contenido de Arcilla (%) en sedimentos marinos**"
    )
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 2")
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black",
    row.striping.include_table_body = TRUE
  )

tabla_media_gt
Tabla N.° 3
Intervalo de confianza del contenido de Arcilla (%) en sedimentos marinos
Límite inferior Media poblacional Límite superior Error estándar
12.33 12.52 12.71 0.0941
Autor: Grupo 2

11. CONCLUSIÓN

La variable contenido de arcilla (CLAY_PCT) se ajusta al modelo exponencial con parámetro \(\lambda=\) 0.0799. La probabilidad de que una muestra presente un contenido de arcilla entre el 10 % y el 30 % es de 35.88 %. Asimismo, se estima que, de 300 nuevas muestras, aproximadamente 108 presentarían valores dentro de este intervalo. Finalmente, con un nivel de confianza del 95 %, la media poblacional del contenido de arcilla se encuentra entre 12.33 % y 12.71 %.