Análisis inferencial de Depósitos Masivos de Sulfuro Volcánicos (Variable Era Geológica)
Grupo 2
2026-02-11
ANÁLISIS ESTADÍSTICO
CARGA DE DATOS Y LIBRERÍAS
CARGA DE DATOS
#Carga de datos
datos <- read.csv("C:\\Users\\joeja\\Desktop\\Proyecto Estadística\\Depositos_sulfuro.csv",
header = TRUE,
sep = ";",
dec = ".")
datos2 <- read.csv("C:\\Users\\joeja\\Desktop\\Proyecto Estadística\\Clasificacion depage.csv",
header = TRUE,
sep = ";",
dec = ".")CARGA DE LIBRERIAS
#Carga de librerias
library(dplyr)
library(gt)
library(knitr)TABLA DE DISTRIBUCIÓN DE PROBABILIDAD
TABLA DE DISTRIBUCION DE PROBABILIDAD POR EDAD GEOLÓGICA
# TABLA DE FRECUENCIAS – VARIABLE EDAD GEOLOGICA
edad <- datos$depage
ni <- table(edad)
hi <- prop.table(ni) * 100
tabla_final <- data.frame(
edad = names(ni),
ni = as.numeric(ni),
hi = as.numeric(hi)
)
fila_total <- data.frame(
edad = "TOTAL",
ni = sum(tabla_final$ni),
hi = sum(tabla_final$hi)
)
tabla_final_p <- rbind(tabla_final, fila_total)
tabla_final_p## edad ni hi
## 1 TOTAL 0 0TABLA DE DISTRIBUCIÓN DE PROBABILIDAD AGRUPADA
Debido a que la tabla presenta numerosos registros de edad geológicas , se decidió agruparlos por eras geológicas convirtiendose en una variable ordinal
TABLA DE DISTRIBUCION DE PROBABILIDAD AGRUPADA
# VARIABLE ERA GEOLÓGICA
Era <- as.character(datos2$Classificacion)
Era <- Era[!is.na(Era)]
Era <- chartr("áéíóúÁÉÍÓÚ", "aeiouAEIOU", Era)
Era <- gsub("precambico|precámbico", "Precambrico", Era, ignore.case = TRUE)
Era <- gsub("paleozoico", "Paleozoico", Era, ignore.case = TRUE)
Era <- gsub("mesozoico", "Mesozoico", Era, ignore.case = TRUE)
Era <- gsub("cenozoico", "Cenozoico", Era, ignore.case = TRUE)
Era <- factor(
Era,
levels = c("Precambrico", "Paleozoico", "Mesozoico", "Cenozoico"),
ordered = TRUE
)
# TABLA DE DISTRIBUCIÓN DE FRECUENCIAS – ERA
ni <- table(Era)
hi <- round(prop.table(ni), 3)
tabla_era <- data.frame(
Era = names(ni),
ni = as.numeric(ni),
hi = as.numeric(hi) * 100,
P = as.numeric(hi) * 100
)
# CRITERIO NUMÉRICO ORDINAL
tabla_era$Era_num <- NA
tabla_era$Era_num[tabla_era$Era == "Precambrico"] <- 1
tabla_era$Era_num[tabla_era$Era == "Paleozoico"] <- 2
tabla_era$Era_num[tabla_era$Era == "Mesozoico"] <- 3
tabla_era$Era_num[tabla_era$Era == "Cenozoico"] <- 4
fila_total2 <- data.frame(
Era = "TOTAL",
ni = sum(tabla_era$ni),
hi = sum(tabla_era$hi),
P = sum(tabla_era$P),
Era_num = NA
)
tabla_era_f <- rbind(tabla_era, fila_total2)
tabla_era_f## Era ni hi P Era_num
## 1 Precambrico 343 31.6 31.6 1
## 2 Paleozoico 522 48.0 48.0 2
## 3 Mesozoico 149 13.7 13.7 3
## 4 Cenozoico 73 6.7 6.7 4
## 5 TOTAL 1087 100.0 100.0 NATABLA DE DISTRIBUCION DE PROBABILIDAD AGRUPADA FINAL
tabla_era_gt <- tabla_era_f %>%
gt() %>%
tab_header(
title = md("**Tabla N° 1**"),
subtitle = md("Distribución de probabilidad de la era geológica en <br>
depósitos masivos de sulfuros volcánicos")
) %>%
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",
row.striping.include_table_body = TRUE
)
tabla_era_gt| Tabla N° 1 | ||||
| Distribución de probabilidad de la era geológica en depósitos masivos de sulfuros volcánicos |
||||
| Era | ni | hi | P | Era_num |
|---|---|---|---|---|
| Precambrico | 343 | 31.6 | 31.6 | 1 |
| Paleozoico | 522 | 48.0 | 48.0 | 2 |
| Mesozoico | 149 | 13.7 | 13.7 | 3 |
| Cenozoico | 73 | 6.7 | 6.7 | 4 |
| TOTAL | 1087 | 100.0 | 100.0 | NA |
| Autor: Grupo 2 | ||||
GRÁFICAS DE DISTRIBUCIÓN DE PROBABILIDAD
Diagrama de barras
hi_global <- tabla_era$P[tabla_era$Era != "TOTAL"]
eras_num <- tabla_era$Era_num[tabla_era$Era != "TOTAL"]
barplot(
hi_global,
main = "Gráfica N°1: Distribución de probabilidad de la era geológica
Depósitos masivos de sulfuros volcánicos",
xlab = "Era geológica ",
ylab = "Probabilidad (%) ",
col = "gray",
names.arg = eras_num,
ylim = c(0, 100)
)
mtext(
"1=Precambrico 2=Paleozoico 3=Mesozoico 4=Cenozoico",
side = 1,
line = 4,
cex = 0.8
)
CONJETURA DEL MODELO
MODELO BINOMIAL
#CONJETURA DEL MODELO
#Tamaño muestral
n <- sum(tabla_era$ni)
n## [1] 1087x <- tabla_era$ni
x## [1] 343 522 149 73X <- 1:(length(x))
X## [1] 1 2 3 4media_observada <- sum(X* x) / n
media_observada## [1] 1.955842#p
p <- media_observada / (length(x))
p## [1] 0.4889604# q
q <- 1 - p
q## [1] 0.5110396#Aplicar la fórmula: P(X = x) = C(n,x) * p^x * q^(n-x)
P_binomial <- dbinom(X, size = length(x), prob = p)
P_binomial## [1] 0.26103412 0.37463447 0.23896576 0.05716035# Representar en porcentaje Fe y Fo
Fo<-(tabla_era$ni/n)*100
Fo## [1] 31.554738 48.022079 13.707452 6.715731Fe<-P_binomial*100
Fe## [1] 26.103412 37.463447 23.896576 5.716035barplot(rbind(Fo,Fe), beside = TRUE,
col = c("skyblue", "blue"),
names.arg = tabla_era$Era_num,
main = "Gráfica N°2: Comparación de la realidad con el
modelo binomial de la era geológica de los depósitos
masivos de sulfuros volcánicos",
ylab = "Probabilidad (%)",
xlab = "Era geológica",
ylim = c(0,100))
mtext(
"1=Precambrico 2=Paleozoico 3=Mesozoico 4=Cenozoico",
side = 1,
line = 4,
cex = 0.8
)
legend("topright", legend = c("Real", "Modelo"),
fill = c("skyblue", "blue"), cex = 0.5)
TEST DE APROBACIÓN
Test de Pearson
#TEST DE PEARSON
plot(Fo, Fe, main = "Gráfica N°3: Correlación de frecuencias
en el modelo Binomial de la era
geológica",
xlab="Frecuencia Observada (%)",
ylab = "Frecuencia Esperada (%)",
pch = 19,
col = "darkblue")
abline(lm(Fe ~ Fo - 1), col = "red", lwd = 2)
Correlación<-cor(Fo,Fe)*100
Correlación## [1] 90.03852APRUEBA TEST DE PEARSON
Test de Chi-Cuadrado
#TEST DE CHI-CUADRADO
K <- (length(x))
K## [1] 4gl<- K-1
gl## [1] 3x2<-sum((Fo-Fe)^2/Fe)
x2## [1] 8.633581vc<-qchisq(0.99,gl) ##Subir el nivel de significancia para aprobar el test de chi-cuadrado
vc## [1] 11.34487x2<vc## [1] TRUEAPRUEBA TEST DE CHI-CUADRADO
TABLA DE RESUMEN
#TABLA RESUMEN
Variable<-c("Era geológica")
tabla_resumen<-data.frame(Variable,round(Correlación,2),round(x2,2),round(vc,2))
colnames(tabla_resumen)<-c("Variable","Test Pearson (%)","Chi Cuadrado","Umbral de aceptación")
library(knitr)
kable(tabla_resumen, format = "markdown", caption = "Tabla Nº2: Resumen de test de bondad al modelo de probabilidad")| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de aceptación |
|---|---|---|---|
| Era geológica | 90.04 | 8.63 | 11.34 |
CÁLCULO DE PROBABILIDADES
¿CUÁL ES LA PROBABILIDAD QUE UN DEPÓSITO DE SULFUROS VOLCÁNICO PERTENEZCA A LA ERA PALEOZOICA?
dbinom(2, size = length(x), prob=p)*100## [1] 37.46345# Gráfico de texto explicativo
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(
x = 1, y = 1,
labels = paste(
"Cálculo de probabilidad\n",
"¿Cuál es la probabilidad que un depósito\n",
"masivo de sulfuro volcánico pertenezca a la \n",
"era Paleozoica?\n",
"Probabilidad = ", round(dbinom(2, size = length(x), prob=p)*100,2), " (%)",
sep = ""
),
cex = 1.4,
col = "black",
font = 2
)
CONCLUSIÓN
La variable era geológica se explica a traves de un modelo binomial aprobando el test de pearson y chi-cuadrado, de esta manera podemos calcular probabilidades. Ejemplo: la probabilidad que un depósito de sulfuro volcánico pertenezca a la era paleozoica es del 37.46%.