ANÁLISIS INFERENCIAL

CARGA DE DATOS Y LIBRERÍAS

# Limpiar entorno
rm(list = ls())

# Cargar librerías necesarias
if (!require("readr")) install.packages("readr")
if (!require("dplyr")) install.packages("dplyr")
if (!require("knitr")) install.packages("knitr")
if (!require("gt")) install.packages("gt")

library(readr)
library(dplyr)
library(knitr)
library(gt)

# Cargar datos
ruta <- "D:/SIO2_with_depth.csv"
datos <- read_csv(ruta)

EXTRACCIÓN DE LA VARIABLE

# Extracción y limpieza de la variable
profundidad <- as.numeric(datos$TOP_DEPTH_M)
profundidad <- profundidad[!is.na(profundidad) & profundidad >= 0]

TABLA DE DISTRIBUCIÓN DE FRECUENCIA

# 1. Rango y amplitud ajustada para 10 intervalos
min_prof <- floor(min(profundidad, na.rm = TRUE))
max_prof <- ceiling(max(profundidad, na.rm = TRUE))
A_ajustada <- ceiling((max_prof - min_prof) / 10)

# 2. Cortes para los 10 intervalos
mis_breaks <- seq(from = min_prof, by = A_ajustada, length.out = 11)

# 3. Histograma base
histo_prof <- hist(
  profundidad,
  breaks = mis_breaks,
  plot = FALSE,
  right = FALSE
)

# 4. Cálculo de estadísticas
Li2 <- histo_prof$breaks[1:(length(histo_prof$breaks) - 1)]
Ls2 <- histo_prof$breaks[2:length(histo_prof$breaks)]
MC2 <- (Li2 + Ls2) / 2
ni2 <- histo_prof$counts
hi2 <- (ni2 / sum(ni2)) * 100

Ni2_asc <- cumsum(ni2)
Hi2_asc <- cumsum(hi2)
Ni2_desc <- rev(cumsum(rev(ni2)))
Hi2_desc <- rev(cumsum(rev(hi2)))

# 5. Formato de intervalos como texto
Intervalo2 <- paste0("[", Li2, " - ", Ls2, ")")
Intervalo2[length(Intervalo2)] <- paste0("[", Li2[length(Li2)], " - ", Ls2[length(Ls2)], "]")

# Construcción de la dataframe final
TDF_prof_final <- data.frame(
  Intervalo = Intervalo2,
  MC = MC2,
  ni = ni2,
  hi = round(hi2, 2),
  Ni_asc = Ni2_asc,
  Hi_asc = round(Hi2_asc, 2),
  Ni_desc = Ni2_desc,
  Hi_desc = round(Hi2_desc, 2)
)

totaless <- data.frame(
  Intervalo = "Totales",
  MC = "-",
  ni = sum(ni2),
  hi = round(sum(hi2), 2),
  Ni_asc = "-",
  Hi_asc = "-",
  Ni_desc = "-",
  Hi_desc = "-"
)

TDF_prof_final <- rbind(TDF_prof_final, totaless)

# Formateo con gt()
TDF_prof_final %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nro. 1*"),
    subtitle = md("*Distribución de frecuencia simplificada de la profundidad de la muestra*")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 2")
  ) %>%
  tab_style(
    style = cell_borders(sides = c("left", "right"), color = "black", weight = px(2)),
    locations = cells_body()
  ) %>%
  tab_style(
    style = cell_borders(sides = c("left", "right"), color = "black", weight = px(2)),
    locations = cells_column_labels()
  ) %>%
  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"
  )

Intervalo	MC	ni	hi	Ni_asc	Hi_asc	Ni_desc	Hi_desc
Tabla Nro. 1
Distribución de frecuencia simplificada de la profundidad de la muestra
[0 - 82)	41	91	3.64	91	3.64	2500	100
[82 - 164)	123	286	11.44	377	15.08	2409	96.36
[164 - 246)	205	334	13.36	711	28.44	2123	84.92
[246 - 328)	287	489	19.56	1200	48	1789	71.56
[328 - 410)	369	498	19.92	1698	67.92	1300	52
[410 - 492)	451	428	17.12	2126	85.04	802	32.08
[492 - 574)	533	245	9.80	2371	94.84	374	14.96
[574 - 656)	615	100	4.00	2471	98.84	129	5.16
[656 - 738)	697	24	0.96	2495	99.8	29	1.16
[738 - 820]	779	5	0.20	2500	100	5	0.2
Totales	-	2500	100.00	-	-	-	-
Autor: Grupo 2

GRÁFICA DE DISTRIBUCIÓN DE FRECUENCIA

plot(
  histo_prof,
  freq = FALSE,
  main = "Gráfica Nro. 1\nDistribución porcentual de la profundidad de la muestra",
  xlab = "Profundidad de la muestra (m)",
  ylab = "Porcentaje (%)",
  xaxt = "n",
  cex.main = 1,
  ylim = c(0, max(hi2))
)

abline(v = mis_breaks, col = "gray70", lty = 2, lwd = 0.8)
abline(h = axTicks(2), col = "gray70", lty = 2, lwd = 0.8)

rect(
  histo_prof$breaks[-length(histo_prof$breaks)],
  0,
  histo_prof$breaks[-1],
  hi2,
  col = "gray",
  border = "black"
)

axis(
  1,
  at = mis_breaks,
  labels = round(mis_breaks, 0),
  las = 1,
  cex.axis = 0.9
)

box()

CONJETURA DEL MODELO

mu <- mean(profundidad)
sigma <- sd(profundidad)

cat("Media poblacional (mu) =", round(mu, 4), "\n")

## Media poblacional (mu) = 335.2504

cat("Desviación estándar (sigma) =", round(sigma, 4), "\n")

## Desviación estándar (sigma) = 146.5103

hist(
  profundidad,
  breaks = mis_breaks,
  freq = FALSE,
  col = NA,
  border = NA,
  main = "Gráfica Nro. 2\nComparación de la realidad y el modelo normal de la profundidad",
  xlab = "Profundidad de la muestra (m)",
  ylab = "Densidad de probabilidad",
  xaxt = "n",
  yaxt = "n",
  ylim = c(0, max(hi2) * 1.25)
)

abline(v = mis_breaks, col = "gray80", lty = 2)
abline(h = pretty(c(0, max(hi2))), col = "gray80", lty = 2)

rect(
  histo_prof$breaks[-length(histo_prof$breaks)],
  0,
  histo_prof$breaks[-1],
  hi2,
  col = "gray",
  border = "black"
)

# Curva normal convertida a la escala porcentual del gráfico
x <- seq(min(profundidad), max(profundidad), length = 1000)
y <- dnorm(x, mean = mu, sd = sigma) * A_ajustada * 100

lines(x, y, col = "blue", lwd = 2)

axis(1, at = mis_breaks, labels = mis_breaks, las = 1, cex.axis = 0.8)
axis(2, at = pretty(c(0, max(hi2))), las = 1)

legend(
  "topright",
  legend = c("Datos reales (FO)", "Modelo normal (FE)"),
  col = c("gray", "blue"),
  lty = c(NA, 1),
  pch = c(22, NA),
  pt.bg = c("gray", NA),
  pt.cex = 2,
  lwd = c(1, 3),
  bty = "n"
)

box()

TEST DE APROBACIÓN

N <- length(profundidad)

# Frecuencias observadas por intervalo
fo_counts <- ni2
fo_rel <- fo_counts / N

# Probabilidades teóricas normales por intervalo
k <- length(fo_counts)
P <- numeric(k)

for (i in 1:k) {
  P[i] <- pnorm(Ls2[i], mean = mu, sd = sigma) - pnorm(Li2[i], mean = mu, sd = sigma)
}

# Frecuencias esperadas
fe_counts <- P * N
fe_rel <- P

# Correlación de Pearson
Coef_Pearson <- cor(fo_counts, fe_counts) * 100

# Chi-Cuadrado (usando proporciones para consistencia de escala)
Chi_Calculado <- sum((fo_rel - fe_rel)^2 / fe_rel)
gl <- k - 1
Chi_Critico <- qchisq(0.95, df = gl)

# Resultados
cat("Coeficiente de Pearson (%):", round(Coef_Pearson, 2), "\n")

## Coeficiente de Pearson (%): 98.31

cat("Chi-Cuadrado Calculado:", round(Chi_Calculado, 4), "\n")

## Chi-Cuadrado Calculado: 0.0219

cat("Chi-Cuadrado Crítico:", round(Chi_Critico, 4), "\n")

## Chi-Cuadrado Crítico: 16.919

# Decisión
if (Chi_Calculado < Chi_Critico) {
  print("Evaluado: El modelo normal es adecuado.")
} else {
  print("Se rechaza: El modelo normal no es adecuado.")
}

## [1] "Evaluado: El modelo normal es adecuado."

ESTIMACIONES

# PREGUNTA DE PROBABILIDAD (INTERVALO 250 - 450 m)
prob_250_450 <- (pnorm(450, mean = mu, sd = sigma) - pnorm(250, mean = mu, sd = sigma))
prob_250_450_pct <- prob_250_450 * 100

cat("Probabilidad entre 250m y 450m =", round(prob_250_450_pct, 2), "%\n")

## Probabilidad entre 250m y 450m = 50.29 %

# PREGUNTA DE CANTIDAD
# ¿Cuántas de 300 futuras muestras estarán entre 250 y 450 metros?
muestras_300 <- prob_250_450 * 300
cat("Muestras esperadas (de 300) =", round(muestras_300, 2), "\n")

## Muestras esperadas (de 300) = 150.88

# DEMOSTRACIÓN GRÁFICA DE PROBABILIDAD
x <- seq(min(profundidad), max(profundidad), by = 0.01)
y <- dnorm(x, mean = mu, sd = sigma) * 100 * A_ajustada

plot(
  x, y,
  col = "skyblue3", lwd = 2, type = "l",
  xlim = c(min(profundidad), max(profundidad)),
  ylim = c(0, max(y)),
  main = "Gráfica Nro. 3\nDemostración de cálculo de probabilidades del modelo normal",
  ylab = "Densidad de probabilidad",
  xlab = "Profundidad de la muestra (m)",
  xaxt = "n"
)

axis(1, at = mis_breaks, labels = mis_breaks, las = 1, cex.axis = 0.8)

# Área de probabilidad P(250 <= X <= 450)
x_sec <- seq(250, 450, by = 0.01)
y_sec <- dnorm(x_sec, mean = mu, sd = sigma) * 100 * A_ajustada

lines(x_sec, y_sec, col = "red", lwd = 2)
polygon(
  c(x_sec, rev(x_sec)),
  c(y_sec, rep(0, length(y_sec))),
  col = rgb(1, 0, 0, 0.4),
  border = NA
)

legend(
  "topright",
  legend = c("Modelo Normal", "Área P(250 ≤ X ≤ 450)"),
  col = c("skyblue3", "red"),
  lwd = 2,
  bty = "o",
  bg = "white"
)

grid()

INTERVALOS DE CONFIANZA

n <- length(profundidad)
t_critico <- qt(0.975, df = n - 1)
error <- t_critico * (sigma / sqrt(n))

limite_inferior <- round(mu - error, 2)
limite_superior <- round(mu + error, 2)

tabla_intervalo <- data.frame(
  Intervalo = paste0("P [", limite_inferior, " < μ < ", limite_superior, "] = 95%")
)

tabla_intervalo %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nro. 2*"),
    subtitle = md("Intervalo de confianza para la media de la profundidad de la muestra")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 2")
  ) %>%
  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"
  )

Intervalo
Tabla Nro. 2
Intervalo de confianza para la media de la profundidad de la muestra
P [329.5 < μ < 341] = 95%
Autor: Grupo 2

CONCLUSIÓN

La variable Profundidad de la muestra se analizó mediante un modelo de probabilidad Normal con una media poblacional de 335.25 m y una desviación estándar de 146.51 m.

A través del modelo ajustado, se determinó que la probabilidad de que una muestra extraída al azar posea una profundidad entre 250 y 450 metros es del 50.29 %. En un lote hipotético de 300 muestras futuras, se estima que aproximadamente 151 muestras estarán dentro de este rango.

Asimismo, con un 95 % de confianza, la media poblacional real se sitúa dentro del intervalo de [329.5 m, 341 m].

PROFUNDIDAD DE LA MUESTRA - MODELO NORMAL

Grupo 2

2026-07-30