#Limpiar entorno
rm(list = ls())

#Cargar librerías
if (!require("readr")) install.packages("readr")

## Loading required package: readr

if (!require("dplyr")) install.packages("dplyr")

## Loading required package: 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, union

if (!require("knitr")) install.packages("knitr")

## Loading required package: knitr

if (!require("moments")) install.packages("moments")

## Loading required package: moments

library(readr)
library(dplyr)
library(knitr)
library(moments)

#Cargar datos
ruta <- "D:/SIO2_with_depth.csv"
datos <- read_csv(ruta)

## Rows: 2500 Columns: 3

## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): EARTH_MA_2
## dbl (1): TOP_DEPTH_M
## lgl (1): SIO2_WT_PE
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

#====================================================================
# LIMPIEZA DE LA VARIABLE
#====================================================================

profundidad <- as.numeric(datos$TOP_DEPTH_M)

profundidad <- na.omit(profundidad)

#====================================================================
# GRAFICA DE DISTRIBUCIÓN GENERAL
#====================================================================

histograma_prof <- hist(profundidad,
                        main = "Grafica Nº1: Distribución de cantidad de la profundidad de la muestra",
                        xlab = "Profundidad de la muestra (m)",
                        ylab = "Cantidad",
                        col = "gray")

#====================================================================
# HISTOGRAMA Y MODELO NORMAL
#====================================================================

prof_1 <- profundidad

Histograma_1 <- hist(prof_1,
                     freq = FALSE,
                     breaks = seq(0, 850, by = 75),
                     main = "Grafica Nº2: Comparación de la realidad con el modelo de probabilidad
                     normal de la profundidad de la muestra",
                     ylab = "Densidad de probabilidad",
                     xlab = "Profundidad de la muestra (m)",
                     col = "lightgray",
                     border = "black")

#====================================================================
# CALCULO DE PARAMETROS
#====================================================================

h1 <- length(Histograma_1$counts)

u_1 <- mean(prof_1)

sigma_1 <- sd(prof_1)

x <- seq(min(prof_1), max(prof_1), 0.01)

curve(dnorm(x, u_1, sigma_1),
      type = "l",
      col = "blue",
      add = TRUE)

#====================================================================
# TAMAÑO MUESTRAL
#====================================================================

n1 <- length(prof_1)

n1

## [1] 2500

#====================================================================
# FRECUENCIA OBSERVADA
#====================================================================

Fo_1 <- Histograma_1$counts

Fo_1

##  [1]  78 246 271 425 474 436 321 161  73  11   4

#====================================================================
# 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]  66.943907 163.001104 307.081277 447.650497 504.977277 440.818099
##  [7] 297.778295 155.649473  62.948114  19.694432   4.766092

#====================================================================
# TEST DE PEARSON
#====================================================================

#EXPRESAR FE Y FO EN PORCENTAJE

Fo_1 <- (Fo_1/n1)*100

Fo_1

##  [1]  3.12  9.84 10.84 17.00 18.96 17.44 12.84  6.44  2.92  0.44  0.16

Fe_1 <- (Fe_1/n1)*100

Fe_1

##  [1]  2.6777563  6.5200442 12.2832511 17.9060199 20.1990911 17.6327240
##  [7] 11.9111318  6.2259789  2.5179246  0.7877773  0.1906437

#====================================================================
# CORRELACIÓN DE FRECUENCIAS
#====================================================================

plot(Fo_1,
     Fe_1,
     main="Grafica Nº3: Correlación de frecuencias observadas y esperadas
     del modelo normal de la profundidad de la muestra",
     xlab="Frecuencia Observada (%)",
     ylab="Frecuencia Esperada (%)",
     col="blue3")

abline(a = 0,
       b = 1,
       col = "red",
       lwd = 2)

Correlacion_1 <- cor(Fo_1,Fe_1)*100

Correlacion_1

## [1] 98.51127

#====================================================================
# CHI CUADRADO
#====================================================================

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

grados_libertad_1

## [1] 10

nivel_significancia <- 0.95

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

x2_1

## [1] 2.35953

umbral_aceptacion_1 <- qchisq(nivel_significancia,
                              grados_libertad_1)

umbral_aceptacion_1

## [1] 18.30704

#====================================================================
# TABLA RESUMEN
#====================================================================

Variable <- c("Profundidad de la muestra")

tabla_resumen_1 <- data.frame(Variable,
                              round(Correlacion_1,2),
                              round(x2_1,2),
                              round(umbral_aceptacion_1,2))

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

kable(tabla_resumen_1,
      format = "markdown",
      caption = "Tabla resumen del modelo normal")

Tabla resumen del modelo normal
Variable	Test Pearson (%)	Chi Cuadrado	Umbral de aceptación
Profundidad de la muestra	98.51	2.36	18.31

#====================================================================
# PROBABILIDAD
#====================================================================

#¿Cuál es la probabilidad de que una muestra futura
#se encuentre entre 250 y 450 metros de profundidad?

Probabilidad_1 <- (pnorm(450, u_1, sigma_1) -
                   pnorm(250, u_1, sigma_1)) * 100

Probabilidad_1

## [1] 50.29246

#====================================================================
# GRAFICA DE PROBABILIDAD
#====================================================================

x <- seq(min(prof_1), max(prof_1), 0.01)

plot(x,
     dnorm(x, u_1,sigma_1),
     col = "skyblue3",
     lwd = 1,
     main="Grafica Nº4: Cálculo de probabilidades",
     ylab="Densidad de probabilidad",
     xlab="Profundidad de la muestra (m)")

# Definir rango
x_section <- seq(250,450, 0.001)

y_section <- dnorm(x_section, u_1,sigma_1)

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

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 Normal", "Área de Probabilidad"),
       col = c("skyblue3", "red"),
       lwd = 2,
       cex = 0.7)

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

text(x = 50,
     y = 0.0015,
     labels = texto_prob,
     col = "black",
     cex = 0.8,
     font = 2)

#====================================================================
# CANTIDAD ESPERADA
#====================================================================

#¿De 300 futuras muestras cuántas estarán
#entre 250 y 450 metros de profundidad?

cantidad_1 <- (pnorm(450, u_1, sigma_1) -
               pnorm(250, u_1, sigma_1)) * 300

cantidad_1

## [1] 150.8774

#====================================================================
# INTERVALOS DE CONFIANZA
#====================================================================

#Media aritmética

x <- mean(profundidad)

x

## [1] 335.2504

#Desviación estándar

sigma <- sd(profundidad)

sigma

## [1] 146.5103

#Tamaño muestral

n <- length(profundidad)

n

## [1] 2500

#Error estándar

e <- sigma/sqrt(n)

e

## [1] 2.930206

#Intervalo de confianza

li <- x-2*e

li

## [1] 329.39

ls <- x+2*e

ls

## [1] 341.1108

tabla_media <- data.frame(round(li,2),
                          Variable,
                          round(ls,2),
                          round(e,2))

colnames(tabla_media) <- c("Limite inferior",
                           "Media poblacional",
                           "Limite superior",
                           "Error estándar")

kable(tabla_media,
      format = "markdown",
      caption = "Tabla Nro.2: Intervalo de confianza de la media poblacional")

Tabla Nro.2: Intervalo de confianza de la media poblacional
Limite inferior	Media poblacional	Limite superior	Error estándar
329.39	Profundidad de la muestra	341.11	2.93

1 Conclusión

La profundidad de la muestra presenta un comportamiento aproximadamente normal, evidenciado por la forma unimodal de la distribución y por la cercanía existente entre la media aritmética y la mediana.

Los resultados obtenidos muestran un ajuste adecuado al modelo normal, permitiendo aplicar herramientas de inferencia estadística para estimar probabilidades relacionadas con la profundidad de muestreo en análisis geoquímicos y geológicos.

De esta manera, fue posible calcular probabilidades de ocurrencia para determinados intervalos de profundidad, así como estimar la media poblacional mediante intervalos de confianza sustentados en el teorema del límite central.

PROFUNDIDAD DE LA MUESTRA MODELO NORMAL

1 Conclusión