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"
)
# 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]
# 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 | |||
# 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()
# 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()
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 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"
)
| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de aceptación |
|---|---|---|---|
| DISTANCIA_A_FALLA_KM | 99.99 | 0.002 | 16.919 |
# 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()
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 |
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.