ANÁLISIS INFERENCIAL

CARGA DE DATOS Y LIBRERÍAS

CARGA DE LIBRERÍAS

library(readxl)
library(gt)
library(dplyr)
library(knitr)

CARGA DE DATOS

datos <- read_excel(
  "C:/Users/klaus/Downloads/DISTANCIA_A_FALLA_KM_modelo_exponencial_2500.xlsx",
  sheet = "Datos_EXPONENCIAL"
)

EXTRACCIÓN DE LA VARIABLE

# Justificación:
# La variable DISTANCIA_A_FALLA_KM es cuantitativa continua, porque representa
# la distancia en kilómetros desde una muestra o depósito mineral hasta la falla
# geológica más cercana. Puede tomar valores reales positivos y cambia de manera gradual.

# Extracción de la variable distancia a falla

distancia_falla <- datos$DISTANCIA_A_FALLA_KM

# Conversión a numérico y limpieza de posibles NA

distancia_falla <- as.numeric(distancia_falla)

distancia_falla <- distancia_falla[!is.na(distancia_falla)]

# El modelo exponencial trabaja con valores iguales o mayores que cero

distancia_falla <- distancia_falla[distancia_falla >= 0]

TABLA DE DISTRIBUCIÓN DE FRECUENCIA

# Definimos cortes para la tabla general.
# Se crean 10 intervalos que cubren todo el rango de la variable.

limite_general <- ceiling(max(distancia_falla, na.rm = TRUE))

A_general <- ceiling(limite_general / 10)

cortes_exactos <- seq(0, A_general * 10, by = A_general)

Histograma_distancia <- hist(
  distancia_falla,
  breaks = cortes_exactos,
  plot = FALSE,
  right = FALSE
)

breaks <- Histograma_distancia$breaks

Li <- breaks[1:(length(breaks) - 1)]

Ls <- breaks[2:length(breaks)]

ni <- Histograma_distancia$counts

N <- length(distancia_falla)

# Cálculo de frecuencias y probabilidad

hi <- (ni / N) * 100

p_s <- ni / N

TDF_distancia_simplificado <- data.frame(
  Intervalo = paste0("[", Li, " - ", Ls, ")"),
  ni = ni,
  hi = round(hi, 2),
  p_s = round(p_s, 2)
)

colnames(TDF_distancia_simplificado) <- c(
  "Intervalo",
  "ni",
  "hi(%)",
  "p(s)"
)

totales <- data.frame(
  Intervalo = "Totales",
  ni = sum(ni),
  hi = 100,
  p_s = 1
)

colnames(totales) <- c(
  "Intervalo",
  "ni",
  "hi(%)",
  "p(s)"
)

TDF_distancia_simplificado <- rbind(TDF_distancia_simplificado, totales)

TDF_distancia_simplificado %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nro. 1*"),
    subtitle = md("**Distribución de frecuencia simplificada de la distancia a falla geológica en muestras de depósitos minerales en Estados Unidos**")
  ) %>%
  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",
    
    table.border.left.color = "black",
    table.border.left.style = "solid",
    table.border.left.width = px(1),
    table.border.right.color = "black",
    table.border.right.style = "solid",
    table.border.right.width = px(1),
    
    column_labels.vlines.color = "black",
    column_labels.vlines.style = "solid",
    column_labels.vlines.width = px(1),
    table_body.vlines.color = "black",
    table_body.vlines.style = "solid",
    table_body.vlines.width = px(1)
  )
Tabla Nro. 1
Distribución de frecuencia simplificada de la distancia a falla geológica en muestras de depósitos minerales en Estados Unidos
Intervalo ni hi(%) p(s)
[0 - 3) 1584 63.36 0.63
[3 - 6) 590 23.60 0.24
[6 - 9) 201 8.04 0.08
[9 - 12) 85 3.40 0.03
[12 - 15) 22 0.88 0.01
[15 - 18) 9 0.36 0.00
[18 - 21) 6 0.24 0.00
[21 - 24) 2 0.08 0.00
[24 - 27) 1 0.04 0.00
[27 - 30) 0 0.00 0.00
Totales 2500 100.00 1.00
Autor: Grupo 2

GRÁFICA DE DISTRIBUCIÓN DE FRECUENCIA

# Histograma porcentual de la variable

par(mar = c(5.1, 4.1, 4.1, 2.1))

plot(
  Histograma_distancia,
  freq = FALSE,
  col = NA,
  border = NA,
  main = "Gráfica N°1: Distribución porcentual de la distancia a falla geológica
en muestras de depósitos minerales en Estados Unidos",
  xlab = "Distancia a falla geológica (km)",
  ylab = "Porcentaje (%)",
  xaxt = "n",
  yaxt = "n",
  cex.main = 1,
  ylim = c(0, max(hi) * 1.1)
)

# Cuadrícula

abline(v = breaks, col = "gray70", lty = 2, lwd = 0.8)

abline(h = pretty(c(0, max(hi))), col = "gray70", lty = 2, lwd = 0.8)

# Barras porcentuales

rect(
  breaks[-length(breaks)],
  0,
  breaks[-1],
  hi,
  col = "gray70",
  border = "black"
)

# Eje X

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

# Eje Y

axis(
  2,
  at = pretty(c(0, max(hi))),
  labels = pretty(c(0, max(hi))),
  las = 1
)

box()

TRATAMIENTO DE DATOS

# Se realiza un ajuste para ignorar valores muy alejados en el extremo superior,
# con el fin de mejorar el ajuste visual del modelo exponencial.
# En este caso se conservan distancias menores o iguales a 20 km.

distancia_falla_ajustada <- distancia_falla[distancia_falla <= 20]

# Definimos nuevos cortes de 0 a 20 km en saltos de 2 km

cortes_ajustados <- seq(0, 20, by = 2)

Histograma_ajustado <- hist(
  distancia_falla_ajustada,
  breaks = cortes_ajustados,
  plot = FALSE,
  right = FALSE
)

breaks_ajust <- Histograma_ajustado$breaks

Li_ajust <- breaks_ajust[1:(length(breaks_ajust) - 1)]

Ls_ajust <- breaks_ajust[2:length(breaks_ajust)]

ni_ajust <- Histograma_ajustado$counts

N_ajustado <- length(distancia_falla_ajustada)

# Cálculo de frecuencias y probabilidad

hi_ajust <- (ni_ajust / N_ajustado) * 100

p_s_ajust <- ni_ajust / N_ajustado

TDF_ajustada <- data.frame(
  Intervalo = paste0("[", Li_ajust, " - ", Ls_ajust, ")"),
  ni = ni_ajust,
  hi = round(hi_ajust, 2),
  p_s = round(p_s_ajust, 2)
)

colnames(TDF_ajustada) <- c(
  "Intervalo",
  "ni",
  "hi(%)",
  "p(s)"
)

totales_ajust <- data.frame(
  Intervalo = "Totales",
  ni = sum(ni_ajust),
  hi = 100,
  p_s = 1
)

colnames(totales_ajust) <- c(
  "Intervalo",
  "ni",
  "hi(%)",
  "p(s)"
)

TDF_ajustada <- rbind(TDF_ajustada, totales_ajust)

TDF_ajustada %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nro. 2*"),
    subtitle = md("**Distribución de frecuencia específica de la distancia a falla geológica**")
  ) %>%
  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",
    
    table.border.left.color = "black",
    table.border.left.style = "solid",
    table.border.left.width = px(1),
    table.border.right.color = "black",
    table.border.right.style = "solid",
    table.border.right.width = px(1),
    
    column_labels.vlines.color = "black",
    column_labels.vlines.style = "solid",
    column_labels.vlines.width = px(1),
    table_body.vlines.color = "black",
    table_body.vlines.style = "solid",
    table_body.vlines.width = px(1)
  )
Tabla Nro. 2
Distribución de frecuencia específica de la distancia a falla geológica
Intervalo ni hi(%) p(s)
[0 - 2) 1224 49.04 0.49
[2 - 4) 620 24.84 0.25
[4 - 6) 330 13.22 0.13
[6 - 8) 155 6.21 0.06
[8 - 10) 84 3.37 0.03
[10 - 12) 47 1.88 0.02
[12 - 14) 16 0.64 0.01
[14 - 16) 11 0.44 0.00
[16 - 18) 4 0.16 0.00
[18 - 20) 5 0.20 0.00
Totales 2496 100.00 1.00
Autor: Grupo 2
# GDF específica

par(mar = c(5.1, 4.1, 4.1, 2.1))

plot(
  Histograma_ajustado,
  freq = FALSE,
  col = NA,
  border = NA,
  main = "Gráfica N°2: Distribución porcentual simplificada de la distancia
a falla geológica en depósitos minerales",
  xlab = "Distancia a falla geológica (km)",
  ylab = "Porcentaje (%)",
  xaxt = "n",
  yaxt = "n",
  cex.main = 1,
  ylim = c(0, max(hi_ajust) * 1.1)
)

abline(v = cortes_ajustados, col = "gray70", lty = 2, lwd = 0.8)

abline(h = pretty(c(0, max(hi_ajust))), col = "gray70", lty = 2, lwd = 0.8)

rect(
  cortes_ajustados[-length(cortes_ajustados)],
  0,
  cortes_ajustados[-1],
  hi_ajust,
  col = "gray70",
  border = "black"
)

axis(
  1,
  at = cortes_ajustados,
  labels = cortes_ajustados,
  las = 1,
  cex.axis = 0.9
)

axis(
  2,
  at = pretty(c(0, max(hi_ajust))),
  labels = pretty(c(0, max(hi_ajust))),
  las = 1
)

box()

CONJETURA DEL MODELO

Se conjetura que la variable DISTANCIA_A_FALLA_KM sigue un modelo de probabilidad exponencial, ya que representa una distancia continua positiva. Además, su histograma muestra que la mayor parte de las muestras se concentra en distancias cortas respecto a la falla geológica, mientras que la frecuencia disminuye rápidamente conforme aumenta la distancia.

Este comportamiento es compatible con un modelo exponencial, donde los valores bajos son más frecuentes y los valores altos aparecen con menor probabilidad.

PARÁMETROS

# Calculamos la media de los datos ajustados

media <- mean(distancia_falla_ajustada)

# Calculamos el parámetro lambda del modelo exponencial

lambda <- 1 / media

cat("Media =", round(media, 4), "\n")
## Media = 2.9526
cat("Parámetro lambda =", round(lambda, 6), "\n")
## Parámetro lambda = 0.338685

SOBREPOSICIÓN DE LA REALIDAD CON EL MODELO LOG-NORMAL

# 8. SOBREPOSICIÓN DE LA REALIDAD CON EL MODELO EXPONENCIAL

hist(
  distancia_falla_ajustada,
  breaks = cortes_ajustados,
  freq = FALSE,
  col = NA,
  border = NA,
  main = "Gráfica Nº3:
Comparación de la realidad y el modelo exponencial
de la distancia a falla geológica en depósitos minerales",
  xlab = "Distancia a falla geológica (km)",
  ylab = "Densidad de probabilidad",
  xaxt = "n",
  yaxt = "n",
  ylim = c(0, max(hi_ajust) * 1.25)
)

# Cuadrícula

abline(v = cortes_ajustados, col = "gray80", lty = 2)

abline(h = pretty(c(0, max(hi_ajust))), col = "gray80", lty = 2)

# Barras de la realidad

rect(
  cortes_ajustados[-length(cortes_ajustados)],
  0,
  cortes_ajustados[-1],
  hi_ajust,
  col = "gray80",
  border = "black"
)

# Curva del modelo exponencial

x <- seq(0, 20, length = 1000)

y <- dexp(x, rate = lambda) * 2 * 100

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

# Ejes

axis(
  1,
  at = cortes_ajustados,
  labels = cortes_ajustados
)

axis(
  2,
  at = pretty(c(0, max(hi_ajust))),
  las = 1
)

# Leyenda

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

box()

TEST DE APROBACIÓN

TEST DE PEARSON

fo_pearson <- ni_ajust

fe_pearson <- N_ajustado * (
  pexp(Ls_ajust, rate = lambda) -
    pexp(Li_ajust, rate = lambda)
)

Coef_Pearson <- cor(fo_pearson, fe_pearson) * 100

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

TEST DE CHI-CUADRADO

N_chi <- sum(ni_ajust)

fo <- ni_ajust / N_chi

k <- length(fo)

P <- c(0)

for(i in 1:k){
  
  P[i] <- pexp(
    Ls_ajust[i],
    rate = lambda
  ) -
    pexp(
      Li_ajust[i],
      rate = lambda
    )
  
}

fe <- P

Chi_Calculado <- sum((fo - fe)^2 / fe)

gl <- k - 1

Chi_Critico <- qchisq(0.95, df = gl)

cat("Chi Calculado:", round(Chi_Calculado, 4), "\n")
## Chi Calculado: 0.002
cat("Chi Crítico:", round(Chi_Critico, 4), "\n")
## Chi Crítico: 16.919
if (Chi_Calculado < Chi_Critico) {
  
  print("Evalúa H0: El modelo exponencial es adecuado.")
  
} else {
  
  print("Se rechaza H0: El modelo exponencial no es adecuado.")
  
}
## [1] "Evalúa H0: El modelo exponencial es adecuado."

TABLA RESUMEN

Variable <- c("DISTANCIA_A_FALLA_KM")

tabla_resumen_exponencial <- data.frame(
  Variable,
  round(Coef_Pearson, 2),
  round(Chi_Calculado, 4),
  round(Chi_Critico, 4)
)

colnames(tabla_resumen_exponencial) <- c(
  "Variable",
  "Test Pearson (%)",
  "Chi Cuadrado",
  "Umbral de aceptación"
)

kable(
  tabla_resumen_exponencial,
  format = "markdown",
  caption = "Tabla resumen del modelo exponencial"
)
Tabla resumen del modelo exponencial
Variable Test Pearson (%) Chi Cuadrado Umbral de aceptación
DISTANCIA_A_FALLA_KM 99.99 0.002 16.919

ESTIMACIONES

# PREGUNTA DE PORCENTAJE
# ¿Cuál es la probabilidad de que la distancia a falla geológica
# no supere los 5 km?

prob_5 <- pexp(5, rate = lambda)

prob_5_porcentaje <- prob_5 * 100

cat(
  "Probabilidad de que la distancia a falla no supere los 5 km:",
  round(prob_5_porcentaje, 2),
  "%\n"
)
## Probabilidad de que la distancia a falla no supere los 5 km: 81.61 %
# PREGUNTA DE CANTIDAD
# ¿Cuántas muestras de 300 futuras se espera que no superen los 5 km
# de distancia a una falla geológica?

muestras_300 <- prob_5 * 300

cat(
  "Cantidad esperada de muestras:",
  round(muestras_300),
  "muestras\n"
)
## Cantidad esperada de muestras: 245 muestras
# PREGUNTA DE INTERVALO
# ¿Cuál es la probabilidad de que la distancia a falla geológica
# se encuentre entre 2 y 5 km?

prob_2_5 <- (
  pexp(5, rate = lambda) -
    pexp(2, rate = lambda)
) * 100

cat(
  "Probabilidad entre 2 y 5 km:",
  round(prob_2_5, 2),
  "%\n"
)
## Probabilidad entre 2 y 5 km: 32.41 %
# DEMOSTRACIÓN GRÁFICA

x <- seq(0, 20, by = 0.01)

y <- dexp(x, rate = lambda)

y <- y * 100 * 2

plot(
  x,
  y,
  col = "orange",
  lwd = 2,
  type = "l",
  xlim = c(0, 20),
  ylim = c(0, max(y)),
  main = "Gráfica N°4: Cálculo de probabilidad
para la distancia a falla geológica",
  ylab = "Densidad de probabilidad",
  xlab = "Distancia a falla geológica (km)",
  xaxt = "n"
)

axis(
  1,
  at = seq(0, 20, 2),
  las = 1
)

# Área P(Distancia ≤ 5)

x_section <- seq(0, 5, 0.01)

y_section <- dexp(x_section, rate = lambda)

y_section <- y_section * 100 * 2

lines(
  x_section,
  y_section,
  col = "darkgreen",
  lwd = 2
)

polygon(
  c(x_section, rev(x_section)),
  c(y_section, rep(0, length(y_section))),
  col = rgb(0, 0.6, 0, 0.35),
  border = NA
)

# Área P(2 ≤ Distancia ≤ 5)

x_section2 <- seq(2, 5, 0.01)

y_section2 <- dexp(x_section2, rate = lambda)

y_section2 <- y_section2 * 100 * 2

lines(
  x_section2,
  y_section2,
  col = "blue",
  lwd = 2
)

polygon(
  c(x_section2, rev(x_section2)),
  c(y_section2, rep(0, length(y_section2))),
  col = rgb(0, 0, 1, 0.35),
  border = NA
)

legend(
  "topright",
  legend = c(
    "Modelo exponencial",
    "Área P(Distancia ≤ 5 km)",
    "Área P(2 ≤ Distancia ≤ 5 km)"
  ),
  col = c(
    "orange",
    "darkgreen",
    "blue"
  ),
  lwd = 2,
  bty = "o",
  bg = "white"
)

grid()

INTERVALO DE CONFIANZA

media_ic <- mean(distancia_falla_ajustada)

desviacion_ic <- sd(distancia_falla_ajustada)

n_ic <- length(distancia_falla_ajustada)

error <- 1.96 * (desviacion_ic / sqrt(n_ic))

limite_inferior <- round(media_ic - error, 2)

limite_superior <- round(media_ic + error, 2)

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

tabla_intervalo %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nro. 3*"),
    subtitle = md("**Intervalo de confianza de la distancia media a falla geológica en depósitos minerales**")
  ) %>%
  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",
    table.border.left.color = "black",
    table.border.left.style = "solid",
    table.border.left.width = px(1),
    table.border.right.color = "black",
    table.border.right.style = "solid",
    table.border.right.width = px(1)
  )
Tabla Nro. 3
Intervalo de confianza de la distancia media a falla geológica en depósitos minerales
Intervalo
P [2.84 < µ < 3.07] = 95%
Autor: Grupo 2

CONCLUSIÓN

La variable DISTANCIA_A_FALLA_KM se puede explicar mediante un modelo exponencial con parámetro λ = 0.339. Podemos afirmar con un 95% de confianza que la media poblacional de esta variable se encuentra aproximadamente entre 2.84 y 3.07 km, con una media observada de 2.95 km y una desviación estándar de 2.87 km. Además, se evidencia una distribución asimétrica positiva, ya que la mayor parte de las muestras se encuentra a distancias cortas de las fallas geológicas, mientras que pocas muestras aparecen a distancias mayores. Este comportamiento es consistente con un modelo exponencial aplicado al análisis geológico de depósitos minerales.