Análisis inferencial de LATITUD
Grupo 1
07-02-2026
1 CARGA DE DATOS
# CARGAR DATOS
datos <- read.csv(
"Datos Mineros.csv",
header = TRUE,
sep = ";",
dec = ".",
fileEncoding = "latin1"
)1.1 CARGA DE LIBRERIAS
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(knitr)
library(gt)
library(MASS)##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## select2 TABLA DE DISTRIBUCION DE FRECUENCIA
# Limpieza de la variable
latitud <- as.numeric(datos$LATITUDE)
latitud <- na.omit(latitud)
# Crear histograma
histograma_lat <- hist(
latitud,
plot = FALSE)#LIMITE INFERIOR SIMPLIFICADA
lis<- histograma_lat$breaks[1:13]
lis## [1] 24 26 28 30 32 34 36 38 40 42 44 46 48#LIMITE SUPERIOR SIMPLIFICADA
lss<-histograma_lat$breaks[2:14]
lss## [1] 26 28 30 32 34 36 38 40 42 44 46 48 50#MARCA DE CLASE
MC_f<-histograma_lat$mids
MC_f## [1] 25 27 29 31 33 35 37 39 41 43 45 47 49# Frecuencia absoluta(ni)
ni_f <-histograma_lat $counts
ni_f## [1] 12 41 82 108 588 330 1170 1188 792 240 190 191 13# Frecuencia relativa (hi)
hi_f <- (ni_f/sum(ni_f))*100
hi_f## [1] 0.2426694 0.8291203 1.6582406 2.1840243 11.8907988 6.6734075
## [7] 23.6602629 24.0242669 16.0161780 4.8533873 3.8422649 3.8624874
## [13] 0.2628918# Tabla de frecuencias
TDFlat_f <- round(data.frame(
lis, lss, MC_f, ni_f, hi_f
), 2)
# Fila total
fila_total_f <- data.frame(
lis = "TOTAL",
lss = "",
MC_f = "",
ni_f = sum(TDFlat_f$ni_f),
hi_f = 100 # total en porcentaje
)
# Combinar tabla con fila total
TDFlat_t <- rbind(TDFlat_f, fila_total_f)
TDFlat_t## lis lss MC_f ni_f hi_f
## 1 24 26 25 12 0.24
## 2 26 28 27 41 0.83
## 3 28 30 29 82 1.66
## 4 30 32 31 108 2.18
## 5 32 34 33 588 11.89
## 6 34 36 35 330 6.67
## 7 36 38 37 1170 23.66
## 8 38 40 39 1188 24.02
## 9 40 42 41 792 16.02
## 10 42 44 43 240 4.85
## 11 44 46 45 190 3.84
## 12 46 48 47 191 3.86
## 13 48 50 49 13 0.26
## 14 TOTAL 4945 100.00# Mejorar la Tabla
tabla_lat_f <- TDFlat_t %>%
gt() %>%
tab_header(
title = md("*Tabla Nº:1*"),
subtitle = md("Distribución de cantidad de latitud en Accidentes Mineros")
) %>%
tab_source_note(
source_note = md("Autor: GRUPO 1")
) %>%
cols_align(
align = "center",
columns = everything()
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
table_body.hlines.color = "gray"
)
tabla_lat_f| Tabla Nº:1 | ||||
| Distribución de cantidad de latitud en Accidentes Mineros | ||||
| lis | lss | MC_f | ni_f | hi_f |
|---|---|---|---|---|
| 24 | 26 | 25 | 12 | 0.24 |
| 26 | 28 | 27 | 41 | 0.83 |
| 28 | 30 | 29 | 82 | 1.66 |
| 30 | 32 | 31 | 108 | 2.18 |
| 32 | 34 | 33 | 588 | 11.89 |
| 34 | 36 | 35 | 330 | 6.67 |
| 36 | 38 | 37 | 1170 | 23.66 |
| 38 | 40 | 39 | 1188 | 24.02 |
| 40 | 42 | 41 | 792 | 16.02 |
| 42 | 44 | 43 | 240 | 4.85 |
| 44 | 46 | 45 | 190 | 3.84 |
| 46 | 48 | 47 | 191 | 3.86 |
| 48 | 50 | 49 | 13 | 0.26 |
| TOTAL | 4945 | 100.00 | ||
| Autor: GRUPO 1 | ||||
3 GRÁFICA DE DISTRIBUCIÓN DE PROBABILIDAD
#Gráfica de la variable
histograma_lat <- hist(latitud,
main = "Gráfica Nº1: Distribución de cantidad de la latitud
en depósitos masivos de sulfuros volcánicos",
xlab = "Latitud",
ylab = "Cantidad",
col = "gray")
4 CONJETURA DEL MODELO 1
Debido a la similitud de las barras asociamos con el modelo de probabilidad weibull al tramo 1
# Primer tramo: latitudes entre 24 y 38
lat_1 <- latitud[latitud >= 24 & latitud < 36]
# Histograma primer tramo
Histograma_1 <- hist(lat_1,
freq = FALSE,
breaks = seq(24, 38, by = 2),
main = "Gráfica Nº2: Comparación con modelo normal (primer tramo de latitud)",
ylab = "Densidad de probabilidad",
xlab = "Latitud (°)",
col = "lightgray",
border = "black")
# Número de intervalos
h1 <- length(Histograma_1$counts)
#AJUSTE WEIBULL
#-----------------------------------
ajuste_weibull <- fitdistr(lat_1, "weibull")## Warning in densfun(x, parm[1], parm[2], ...): NaNs producedshape_1 <- ajuste_weibull$estimate["shape"]
scale_1 <- ajuste_weibull$estimate["scale"]
# Curva Weibull
x <- seq(min(lat_1, na.rm = TRUE),
max(lat_1, na.rm = TRUE),
0.01)
curve(dweibull(x, shape_1, scale_1),
type = "l",
col = "red",
add = TRUE)
#Tamaño muestral
n1<-length(lat_1)
n1## [1] 1161#Frecuencia observada
Fo_1<-Histograma_1$counts
Fo_1## [1] 12 41 82 108 588 330 0# Probabilidad (Weibull)
P1 <- c(0)
for (i in 1:h1) {
P1[i] <- pweibull(Histograma_1$breaks[i+1], shape_1, scale_1) -
pweibull(Histograma_1$breaks[i], shape_1, scale_1)
}
# Frecuencia esperada
Fe_1 <- P1 * n1
Fe_1## [1] 2.762458 14.031725 61.882606 221.978954 499.113684 343.445081 17.2330645 TEST DE APROBACIÓN
5.1 TEST DE PEARSON
#EXPRESAR FE Y FO EN PORCENTAJE
Fo_1<-(Fo_1/n1)*100
Fo_1## [1] 1.033592 3.531438 7.062877 9.302326 50.645995 28.423773 0.000000Fe_1 <-(Fe_1/n1)*100
Fe_1## [1] 0.2379378 1.2085896 5.3301125 19.1196343 42.9899814 29.5818330 1.4843293#Grafica de correlación
plot(Fo_1,Fe_1,main="Gráfica N3º: Correlación de frecuencias en el modelo normal
de la Latitud de los depositos masivos de sulfuros volcanicos",
xlab="Frecuencia Observada (%)",
ylab="Frecuencia esperada (%)",
col="blue3")
abline(lm(Fe_1 ~ Fo_1), col="red",lwd=2)
#Aprueba test de pearson con mas del 80%
CorrelaciOn_1<-cor(Fo_1,Fe_1)*100
CorrelaciOn_1## [1] 96.11535“APRUEBA EL TEST”
5.2 TEST DE CHI-CUADRADO
#Gardos de libertad
grados_libertad_1 <- (length(Histograma_1$counts)-1)
grados_libertad_1## [1] 6#Nivel de significancia
nivel_significancia <- 0.99
#Formula de chi-cuadrado
x2_1<-sum((Fe_1-Fo_1)^2/Fe_1)
x2_1## [1] 15.62232#Umbral de aceptación
umbral_aceptacion_1 <- qchisq(nivel_significancia, grados_libertad_1)
umbral_aceptacion_1## [1] 16.81189#Aprueba test de chi cuadrado con true
x2_1<umbral_aceptacion_1## [1] TRUEAPRUEBA TEST DE CHI-CUADRADO
5.3 TABLA DE RESUMEN
Variable<-c("Latitud (°)")
tabla_resumen<-data.frame(Variable,round(CorrelaciOn_1,2),round(x2_1,2),round(umbral_aceptacion_1,2))
colnames(tabla_resumen)<-c("Variable","Test Pearson (%)","Chi Cuadrado","Umbral de aceptación")
kable(tabla_resumen, format = "markdown", caption = "Tabla.Resumen de test de bondad al modelo de probabilidad")| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de aceptación |
|---|---|---|---|
| Latitud (°) | 96.12 | 15.62 | 16.81 |
6 CÁLCULO DE PROBABILIDADES
¿Cuál es la probabilidad de que un accidente minero ocurra en el futuro entre las latitudes 30° y 34°, considerando el modelo probabilístico obtenido para el primer tramo de latitud?
# Probabilidad entre 30° y 34° (Modelo Weibull)
Probabilidad_1 <- (pweibull(34, shape_1, scale_1) -
pweibull(30, shape_1, scale_1)) * 100
Probabilidad_1## [1] 62.10962x <- seq(min(lat_1), max(lat_1), 0.01)
# Curva Weibull
plot(x, dweibull(x, shape_1, scale_1),
col = "skyblue3",
lwd = 1,
main = "Gráfica N°4: Cálculo de probabilidades",
ylab = "Densidad de probabilidad",
xlab = "Latitud (°)")
# Sección a pintar (30 a 34)
x_section <- seq(30, 34, 0.001)
y_section <- dweibull(x_section, shape_1, scale_1)
# Línea roja
lines(x_section, y_section, col = "red", lwd = 2)
# Área bajo la curva
polygon(c(x_section, rev(x_section)),
c(y_section, rep(0, length(y_section))),
col = rgb(1, 0, 0, 0.6))
# Leyenda
legend("topright",
legend = c("Modelo Weibull", "Área de Probabilidad"),
col = c("skyblue3", "red"),
lwd = 2,
cex = 0.7)
# Texto probabilidad
texto_prob <- paste0("Probabilidad = ",
round(Probabilidad_1, 2), " %")
text(x = 31,
y = max(dweibull(x, shape_1, scale_1)) * 0.8,
labels = texto_prob,
col = "black",
cex = 0.8,
font = 2)
¿De 200 accidentes mineros cuantos estaran entre la latitud de 32° a 36° ?
# Probabilidad entre 32° y 36° (Weibull)
prob_32_36 <- pweibull(36, shape_1, scale_1) -
pweibull(32, shape_1, scale_1)
# Número esperado de accidentes en ese rango
accidentes_esperados <- prob_32_36 * 200
accidentes_esperados## [1] 145.14367 CONJETURA DEL MODELO 2
Debido a la similitud de las barras asociamos con el modelo de probabilidad weibull al tramo 2
# Partición de la variable entre 36° y 50°
lat_2 <- latitud[latitud >= 36 & latitud <= 50]
# Transformar a origen > 0
origen <- min(lat_2)
lat_2_adj <- lat_2 - origen + 0.01 # evita ceros
#-----------------------------------
# Histograma (GUARDAR OBJETO)
#-----------------------------------
Histograma_2 <- hist(lat_2,
freq = FALSE,
breaks = seq(36, 50, by = 2),
main = "Gráfica Nº2: Comparación con modelo Weibull",
ylab = "Densidad de probabilidad",
xlab = "Latitud (°)",
col = "lightgray",
border = "black")
#-----------------------------------
# Ajuste Weibull
#-----------------------------------
ajuste_weibull <- fitdistr(lat_2_adj, "weibull")## Warning in densfun(x, parm[1], parm[2], ...): NaNs produced
## Warning in densfun(x, parm[1], parm[2], ...): NaNs produced
## Warning in densfun(x, parm[1], parm[2], ...): NaNs produced
## Warning in densfun(x, parm[1], parm[2], ...): NaNs producedshape_2 <- ajuste_weibull$estimate["shape"]
scale_2 <- ajuste_weibull$estimate["scale"]
#-----------------------------------
# Curva Weibull en escala original
#-----------------------------------
x <- seq(min(lat_2), max(lat_2), 0.01)
x_adj <- x - origen + 0.01
y <- dweibull(x_adj, shape = shape_2, scale = scale_2)
lines(x, y, col = "red", lwd = 2)
h2 <- length(Histograma_2$counts)
# Tamaño muestral
n2 <- length(lat_2)
n2## [1] 3784#Frecuencia Observada
Fo_2 <- Histograma_2$counts
Fo_2## [1] 1170 1188 792 240 190 191 13P2 <- numeric(h2)
for (i in 1:h2) {
a <- Histograma_2$breaks[i] - origen + 0.01
b <- Histograma_2$breaks[i+1] - origen + 0.01
P2[i] <- pweibull(b, shape_2, scale_2) -
pweibull(a, shape_2, scale_2)
}
# Frecuencia esperada
Fe_2 <- P2 * n2
Fe_2## [1] 1006.81138 1210.26819 824.01711 437.13571 194.37469 74.93592 25.551238 TEST DE APROBACIÓN
8.1 TEST DE PEARSON
#EXPRESAR FE Y FO EN PORCENTAJE
Fo_2<-(Fo_2/n2)*100
Fo_2## [1] 30.9196617 31.3953488 20.9302326 6.3424947 5.0211416 5.0475687 0.3435518Fe_2 <-(Fe_2/n2)*100
Fe_2## [1] 26.607066 31.983832 21.776351 11.552212 5.136752 1.980336 0.675244#Grafica de correlación
plot(Fo_2,Fe_2,main="Gráfica N3º: Correlación de frecuencias en el modelo normal
de la Latitud de los depositos masivos de sulfuros volcanicos",
xlab="Frecuencia Observada (%)",
ylab="Frecuencia esperada (%)",
col="blue3")
abline(lm(Fe_2 ~ Fo_2), col="red",lwd=2)
#Aprueba test de pearson con mas del 80%
CorrelaciOn_2<-cor(Fo_2,Fe_2)*100
CorrelaciOn_2## [1] 97.27824“APRUEBA EL TEST”
8.2 TEST DE CHI-CUADRADO
#Gardos de libertad
grados_libertad_2 <- (length(Histograma_2$counts)-1)
grados_libertad_2## [1] 6#Nivel de significancia
nivel_significancia <- 0.99
#Formula de chi-cuadrado
x2_2<-sum((Fe_2-Fo_2)^2/Fe_2)
x2_2## [1] 8.008344#Umbral de aceptación
umbral_aceptacion_2 <- qchisq(nivel_significancia, grados_libertad_2)
umbral_aceptacion_2## [1] 16.81189#Aprueba test de chi cuadrado con true
x2_2<umbral_aceptacion_2## [1] TRUE“APRUEBA TEST DE CHI-CUADRADO”
8.3 TABLA DE RESUMEN
Variable<-c("Latitud(°)")
tabla_resumen<-data.frame(Variable,round(CorrelaciOn_2,2),round(x2_2,2),round(umbral_aceptacion_2,2))
colnames(tabla_resumen)<-c("Variable","Test Pearson (%)","Chi Cuadrado","Umbral de aceptación")
kable(tabla_resumen, format = "markdown", caption = "Tabla.Resumen de test de bondad al modelo de probabilidad")| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de aceptación |
|---|---|---|---|
| Latitud(°) | 97.28 | 8.01 | 16.81 |
9 CÁLCULO DE PROBABILIDADES
¿Cuál es la probabilidad de que un accidente minero ocurra entre las latitudes 40° y 46° según el modelo probabilístico ajustado al segundo tramo?
# Tramo 40° a 46°
a <- 40 - origen + 0.01
b <- 46 - origen + 0.01
Probabilidad_2 <- (pweibull(b, shape_2, scale_2) -
pweibull(a, shape_2, scale_2)) * 100
Probabilidad_2## [1] 38.46531x <- seq(min(lat_2), max(lat_2), 0.01)
x_adj <- x - origen + 0.01
plot(x, dweibull(x_adj, shape_2, scale_2),
col = "skyblue3",
lwd = 1,
main="Gráfica N°7: Cálculo de probabilidades",
ylab="Densidad de probabilidad",
xlab="Latitud (°)")
# Sección a pintar
x_section_2 <- seq(40, 46, 0.001)
x_section_adj <- x_section_2 - origen + 0.01
y_section_2 <- dweibull(x_section_adj, shape_2, scale_2)
lines(x_section_2, y_section_2, col = "red", lwd = 2)
polygon(c(x_section_2, rev(x_section_2)),
c(y_section_2, rep(0, length(y_section_2))),
col = rgb(1, 0, 0, 0.6))
legend("topright",
legend = c("Modelo Weibull", "Área de Probabilidad"),
col = c("skyblue3", "red"),
lwd = 2,
cex = 0.6)
texto_prob <- paste0("Probabilidad = ",
round(Probabilidad_2, 2), " %")
text(mean(c(40,46)),
max(dweibull(x_adj, shape_2, scale_2))*0.8,
labels = texto_prob,
col = "black",
cex = 0.8,
font = 2)
¿De cada 100 accidentes mineros futuros, ¿cuántos se espera que ocurran entre las latitudes 40° y 46°?
a <- 40 - origen + 0.01
b <- 46 - origen + 0.01
cantidad_2 <- (pweibull(b, shape_2, scale_2) -
pweibull(a, shape_2, scale_2)) * 100
cantidad_2## [1] 38.4653110 TEOREMA DEL LÍMITE CENTRAL (TLC)
#Media aritmetica
x<-mean(latitud)
x## [1] 38.2586#Desviación estandar
sigma<-sd(latitud)
sigma## [1] 3.93527#Tamaño muestral
n<-length(latitud)
n## [1] 4945#P(x-2e<u<x+2e)=95%
e<-sigma/sqrt(n)
e## [1] 0.05596177li<-x-2*e
li## [1] 38.14668ls<-x+2*e
ls## [1] 38.37052tabla_media<-data.frame(round(li,2),Variable,round(ls,2),e)
colnames(tabla_media)<-c("Limite inferior","Media poblacional","Limite superior", "Desviación estandar poblacional")
library(knitr)
kable(tabla_media, format = "markdown", caption = "Tabla Nro.3: Media poblacional")| Limite inferior | Media poblacional | Limite superior | Desviación estandar poblacional |
|---|---|---|---|
| 38.15 | Latitud(°) | 38.37 | 0.0559618 |
11 CONCLUSIÓN
La variable experiencia minera se explica a través del modelo weibull en dos grupos siendo la media aritmética de 38.25 y una desviación estandar de 3.93.
De esta manera logramos calcular probabilidades como por ejemplo, que al seleccionar aleatoriamente cualquier latitud dentro de 36° a 40° y su area donde se encuentre entre 40° y 46° es de 38.46%.
Mediante el teorema de limite central, sabemos que la media aritmética poblacional de la latitud se encuentran entre 38.15° y 38.37° con un 98% de confianza.