ANÁLISIS ESTADÍSTICO

CARGA DE DATOS Y LIBRERÍAS

CARGA DE DATOS

#Carga de datos
setwd("~/UNI/ESTADISTICA")
datos  <- read.csv("Depositos_Sulfuro.csv", sep = ";", dec = ".", header = TRUE)

CARGA DE LIBRERIAS

#Carga de librerias
library(dplyr)
library(knitr)
library(gt)

GRÁFICA Y TABLA DE DISTRIBUCIÓN DE FRECUENCIA

# Limpieza de la variable
latitud <- as.numeric(datos$latdeg)
latitud <- na.omit(latitud)


#Grafica de distribución de cantidad

histograma_lat<-hist(latitud,
                     main = "Gráfica Nº1: Distribución de cantidad de la latitud
                     en depositos masivos de sulfuros volcanicos ",
                     xlab = "Latitud",
                     ylab = "Cantidad",
                     col = "gray")

#LIMITE INFERIOR SIMPLIFICADA

lis<- histograma_lat$breaks[1:14]
lis

##  [1] -60 -50 -40 -30 -20 -10   0  10  20  30  40  50  60  70

#LIMITE SUPERIOR SIMPLIFICADA
lss<-histograma_lat$breaks[2:15]
lss

##  [1] -50 -40 -30 -20 -10   0  10  20  30  40  50  60  70  80

#MARCA DE CLASE
MC_f<-histograma_lat$mids
MC_f

##  [1] -55 -45 -35 -25 -15  -5   5  15  25  35  45  55  65  75

# Frecuencia absoluta(ni)
ni_f <-histograma_lat $counts
ni_f

##  [1]   1   7  19  29  14   8  17  51  34 256 332 190 131   1

# Frecuencia relativa (hi)
hi_f <- (ni_f/sum(ni_f))*100
hi_f

##  [1]  0.09174312  0.64220183  1.74311927  2.66055046  1.28440367  0.73394495
##  [7]  1.55963303  4.67889908  3.11926606 23.48623853 30.45871560 17.43119266
## [13] 12.01834862  0.09174312

# TABLA FINAL
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 = round(sum(TDFlat_f$hi_f),)
)

TDFlat_t <- rbind(TDFlat_f, fila_total_f)


# TABLA FINAL
tabla_lat_f <- TDFlat_t %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nº:2*"),
    subtitle = md("Tabla de distribución de cantidad de 
                  latitud en los depósitos masivos de sulfuros")
  ) %>%
  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"
  )

tabla_lat_f

lis	lss	MC_f	ni_f	hi_f
Tabla Nº:2
Tabla de distribución de cantidad de latitud en los depósitos masivos de sulfuros
-60	-50	-55	1	0.09
-50	-40	-45	7	0.64
-40	-30	-35	19	1.74
-30	-20	-25	29	2.66
-20	-10	-15	14	1.28
-10	0	-5	8	0.73
0	10	5	17	1.56
10	20	15	51	4.68
20	30	25	34	3.12
30	40	35	256	23.49
40	50	45	332	30.46
50	60	55	190	17.43
60	70	65	131	12.02
70	80	75	1	0.09
TOTAL			1090	100.00
Autor: GRUPO 2

CONJETURA DEL MODELO 1

Debido a la similitud de las barras asociamos con el modelo de probabilidad normal al tramo 1

# Partición de la variable
lat_1 <- latitud[latitud <0]

# Histograma -60 a 0
Histograma_1<-hist(lat_1,
     freq = FALSE,
     breaks = seq(-60, 0, by = 10),
     main = "Gráfica Nº2: Comparación de la realidad con el modelo de probabilidad
     normal en la latitud de los dépositos masivos de sulfuros volcánicos",
     ylab = "Densidad de probabilidad",
     xlab = "Latitud (°)",
     col = "lightgray",
     border = "black")


# Calculo de Parametros 
h1<-length(Histograma_1$counts)
u_1 <- mean(lat_1)
sigma_1<- sd(lat_1)
x <- seq(min(lat_1), max(lat_1), 0.01)
curve(dnorm(x, u_1, sigma_1), type = "l", col = "blue", add = TRUE)

#Tamaño muestral
n1<-length(lat_1)
n1

## [1] 76

#Frecuencia observada
Fo_1<-Histograma_1$counts
Fo_1

## [1]  1  7 19 29 14  6

#Probabilidad
P1<-c(0)
for (i in 1:h1) {
  P1[i] <-(pnorm(Histograma_1$breaks[i+1],u_1,sigma_1)-
            pnorm(Histograma_1$breaks[i],u_1,sigma_1))}
#Frecuencia Esperada
Fe_1<-P1*n1
Fe_1

## [1]  0.6138733  4.9944024 17.7017161 27.4987465 18.7675401  5.6156593

TEST DE APROBACIÓN

TEST DE PEARSON

#EXPRESAR FE Y FO EN PORCENTAJE
Fo_1<-(Fo_1/n1)*100
Fo_1

## [1]  1.315789  9.210526 25.000000 38.157895 18.421053  7.894737

Fe_1 <-(Fe_1/n1)*100
Fe_1

## [1]  0.8077281  6.5715821 23.2917317 36.1825612 24.6941316  7.3890254

#Correlación de frecuencia esperada con la frecuencia observada

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)

CorrelaciOn_1<-cor(Fo_1,Fe_1)*100
CorrelaciOn_1

## [1] 97.09009

APRUEBA EL TEST PEARSON

TEST DE CHI-CUADRADO

grados_libertad_1 <- (length(Histograma_1$counts)-1)
grados_libertad_1

## [1] 5

nivel_significancia <- 0.95


x2_1<-sum((Fe_1-Fo_1)^2/Fe_1)
x2_1

## [1] 3.240587

umbral_aceptacion_1 <- qchisq(nivel_significancia, grados_libertad_1)
umbral_aceptacion_1

## [1] 11.0705

x2_1<umbral_aceptacion_1

## [1] TRUE

APRUEBA TEST DE CHI-CUADRADO

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")

Tabla.Resumen de test de bondad al modelo de probabilidad
Variable	Test Pearson (%)	Chi Cuadrado	Umbral de aceptación
Latitud (°)	97.09	3.24	11.07

CÁLCULO DE PROBABILIDADES

¿Cuál es la probabilidad de que un depósito masivo de sulfuros volcánicos que se descubra en el futuro se ubique entre las latitudes −40° y −20°?

# PROBABILIDAD ENTRE -40 y -20 g/T

Probabilidad_1 <- (pnorm(-20, u_1, sigma_1) - pnorm(-40, u_1, sigma_1)) * 100
Probabilidad_1

## [1] 59.47429

# Rango para la curva
x <- seq(min(lat_1), max(lat_1), 0.01)

plot(x, dnorm(x, u_1,sigma_1), 
     col = "skyblue3",
     lwd = 1,
     main="Gráfica N 4º: Cálculo de probabilidades",
     ylab="Densidad de probabilidad",
     xlab="Latitud (°)")

# Definir el rango de la sección que quieres pintar
x_section <- seq(-40,-20, 0.001)
y_section <- dnorm(x_section, u_1,sigma_1)

# Pintar la sección de la curva
lines(x_section, y_section, col = "red", lwd = 2)

# Pintar el área debajo de la línea roja
polygon(c(x_section, rev(x_section)), 
        c(y_section, rep(0, length(y_section))),
        col = rgb(1, 0, 0, 0.6))

# Añadir leyenda
# Leyenda
legend("topright",
       legend = c("Modelo Normal", "Área de Probabilidad"),
       col = c("skyblue3", "red"),
       lwd = 2,
       cex = 0.5)

#Texto 
texto_prob <- paste0("Probabilidad = ",
                     round(Probabilidad_1, 2), " %")

text(x = -50,
     y = 0.03,
     labels = texto_prob,
     col = "black",
     cex = 0.7,
     font = 2)

CONJETURA DEL MODELO 2

Debido a la similitud de las barras asociamos con el modelo de probabilidad normal para el tramo 2

# Partición de la variable
lat_2 <- latitud[latitud >= 0]

Histograma_2<-hist(lat_2,
     freq = FALSE,
     breaks = seq(0, 80, by = 10),
     main = "Gráfica Nº5: Comparación de la realidad con el modelo de probabilidad
     normal en la latitud de los dépositos masivos de sulfuros volcánicos",
     xlab = "Latitud (°)",
     ylab = "Densidad de probabilidad",
     col = "lightgray",
     border = "black")

     
# Calculo de Parametros 
u_2 <- mean(lat_2)
sigma_2<- sd(lat_2)
x <- seq(min(lat_2), max(lat_2), 0.01)
curve(dnorm(x, u_2, sigma_2), type = "l", col = "blue", add = TRUE)

h2<-length(Histograma_2$counts)

#Tamaño muestral
n2<-length(lat_2)
n2

## [1] 1014

#Frecuencia Observada
Fo_2 <- Histograma_2$counts 
Fo_2

## [1]  19  51  34 256 332 190 131   1

#Probabilidad
P2<-c(0)
for (i in 1:h2) {
  P2[i] <-(pnorm(Histograma_2$breaks[i+1],u_2,sigma_2)-
             pnorm(Histograma_2$breaks[i],u_2,sigma_2))}

#Fecuencia Esperada
Fe_2<-P2*n2
Fe_2

## [1]   3.825567  25.782065 100.553123 227.349897 298.345922 227.325518 100.531543
## [8]  25.773756

TEST DE APROBACIÓN

TEST DE PEARSON

#EXPRESAR FE Y FO EN PORCENTAJE
Fo_2<-(Fo_2/n2)*100
Fo_2

## [1]  1.87376726  5.02958580  3.35305720 25.24654832 32.74161736 18.73767258
## [7] 12.91913215  0.09861933

Fe_2 <-(Fe_2/n2)*100
Fe_2

## [1]  0.3772748  2.5426100  9.9164816 22.4210944 29.4226747 22.4186901  9.9143534
## [8]  2.5417906

#Correlacion de la frecuencia esperada y frecuencia observada

plot(Fo_2,Fe_2,main="Gráfica N 6º: 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)

Correlación_2<-cor(Fo_2,Fe_2)*100
Correlación_2

## [1] 95.09942

APRUEBA EL TEST PEARSON

TEST DE CHI-CUADRADO

grados_libertad_2 <- (length(Histograma_2$counts)-1)
grados_libertad_2

## [1] 7

nivel_significancia <- 0.99  #Subir el nivel de significacia para aprobar test de chi-cuadrado


x2_2<-(sum((Fe_2-Fo_2)^2/Fe_2))
x2_2

## [1] 17.30655

umbral_aceptacion_2 <- qchisq(nivel_significancia, grados_libertad_2)
umbral_aceptacion_2

## [1] 18.47531

x2_2<umbral_aceptacion_2

## [1] TRUE

APRUEBA TEST DE CHI-CUADRADO

TABLA DE RESUMEN

Variable<-c("Latitud(°)")
tabla_resumen<-data.frame(Variable,round(Correlación_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")

Tabla.Resumen de test de bondad al modelo de probabilidad
Variable	Test Pearson (%)	Chi Cuadrado	Umbral de aceptación
Latitud(°)	95.1	17.31	18.48

CÁLCULO DE PROBABILIDADES

¿Cuál es la probabilidad de que un depósito masivo de sulfuros volcánicos que se descubra en el futuro se ubique entre las latitudes 70° y 50°?

# PROBABILIDAD ENTRE 50 y 70 g/T

Probabilidad_2 <- (pnorm(70, u_2, sigma_2) - pnorm(50, u_2, sigma_2)) * 100
Probabilidad_2

## [1] 32.33304

# Rango para la curva
x <- seq(min(lat_2), max(lat_2), 0.01)

plot(x, dnorm(x, u_2,sigma_2), 
     col = "skyblue3",
     lwd = 1,
     main="Gráfica N 7º: Cálculo de probabilidades",
     ylab="Densidad de probabilidad",
     xlab="Latitud (°)")

# Definir el rango de la sección que quieres pintar
x_section_2 <- seq(50,70, 0.001)
y_section_2 <- dnorm(x_section_2, u_2,sigma_2)

# Pintar la sección de la curva
lines(x_section_2, y_section_2, col = "red", lwd = 2)

# Pintar el área debajo de la línea roja
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))

# Añadir leyenda
# Leyenda
legend("topright",
       legend = c("Modelo Normal", "Área de Probabilidad"),
       col = c("skyblue3", "red"),
       lwd = 2,
       cex = 0.4)

#Texto 
texto_prob <- paste0("Probabilidad = ",
                     round(Probabilidad_2, 2), " %")

text(x = 10,
     y = 0.025,
     labels = texto_prob,
     col = "black",
     cex = 0.7,
     font = 2)

Análisis inferencial de Depósitos Masivos de Sulfuro Volcánicos (Variable Latitud)

Grupo 2

2026-01-19

ANÁLISIS ESTADÍSTICO

CARGA DE DATOS Y LIBRERÍAS

GRÁFICA Y TABLA DE DISTRIBUCIÓN DE FRECUENCIA

CONJETURA DEL MODELO 1

TEST DE APROBACIÓN

CÁLCULO DE PROBABILIDADES

CONJETURA DEL MODELO 2

TEST DE APROBACIÓN

CÁLCULO DE PROBABILIDADES

CONCLUSIONES