Latitude

#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:/PUNTOS LA LO.csv"
datos <- read_csv(ruta)

## Warning: One or more parsing issues, call `problems()` on your data frame for details,
## e.g.:
##   dat <- vroom(...)
##   problems(dat)

## Rows: 2500 Columns: 341

## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (116): FID, DEPOSIT_AN, DEPOSIT_UI, DEPOSIT_NA, DEPOSIT_LO, DEPOSIT_EN,...
## dbl  (164): FE2O3_WT_P, FEO_WT_PER, H2OTOTAL_W, CO2_WT_PER, CO2_DETECT, LOIT...
## lgl   (59): TOP_DEPTH_, BASE_DEPTH, PROVINCE, STRAT_UNIT, STRAT_UN_1, STRAT_...
## date   (2): ANALYSIS_D, LAST_UPDAT
## 
## ℹ 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.

cat("✓ Datos cargados exitosamente\n")

## ✓ Datos cargados exitosamente

cat("✓ Dimensiones:", nrow(datos), "observaciones\n")

## ✓ Dimensiones: 2500 observaciones

#Extraer y limpiar variable de Latitud
# Se asume que la columna correcta en tu CSV es DEPOSIT_LA
LATITUDE_raw <- datos$DEPOSIT_LA
LATITUDE <- as.numeric(LATITUDE_raw)
LATITUDE <- LATITUDE[!is.na(LATITUDE)]
LATITUDE <- LATITUDE[LATITUDE != 0]

n <- length(LATITUDE)

#Parámetros de Sturges
R <- max(LATITUDE) - min(LATITUDE)
k <- floor(1 + 3.3 * log10(n))
A <- R / k

parametros_sturges <- data.frame(
  Parámetro = c("Rango (R)", 
                "Número de datos (n)", 
                "Número de intervalos (k)", 
                "Amplitud de clase (A)"),
  Valor = c(round(R, 4), n, k, round(A, 4))
)

kable(parametros_sturges, 
      caption = "Tabla 1: Parámetros de Sturges para la variable LATITUDE (coordenadas geográficas)")

Tabla 1: Parámetros de Sturges para la variable LATITUDE (coordenadas geográficas)

Parámetro	Valor
Rango (R)	38.2574
Número de datos (n)	2500.0000
Número de intervalos (k)	12.0000
Amplitud de clase (A)	3.1881

#Intervalos y frecuencias
Li <- seq(min(LATITUDE), max(LATITUDE) - A, by = A)
Ls <- seq(min(LATITUDE) + A, max(LATITUDE), by = A)
MC <- (Li + Ls) / 2

ni <- numeric(k)
for (i in 1:k) {
  if (i == k) {
    ni[i] <- sum(LATITUDE >= Li[i] & LATITUDE <= Ls[i])
  } else {
    ni[i] <- sum(LATITUDE >= Li[i] & LATITUDE < Ls[i])
  }
}

hi <- round((ni / n) * 100, 2)
Niasc <- cumsum(ni)
Nidsc <- rev(cumsum(rev(ni)))
Hiasc <- round(cumsum(hi), 2)
Hidsc <- round(rev(cumsum(rev(hi))), 2)

TDF <- data.frame(
  Clase = 1:k,
  Li = round(Li, 2),
  Ls = round(Ls, 2),
  MC = round(MC, 2),
  ni = ni,
  hi = hi,
  Niasc = Niasc,
  Nidsc = Nidsc,
  Hiasc = Hiasc,
  Hidsc = Hidsc
)

kable(TDF,
      caption = "Tabla 2: Distribución de frecuencias de LATITUDE (puntos geográficos)")

Tabla 2: Distribución de frecuencias de LATITUDE (puntos geográficos)

Clase	Li	Ls	MC	ni	hi	Niasc	Nidsc	Hiasc	Hidsc
1	29.81	33.00	31.41	33	1.32	33	2500	1.32	100.00
2	33.00	36.19	34.60	33	1.32	66	2467	2.64	98.68
3	36.19	39.38	37.78	254	10.16	320	2434	12.80	97.36
4	39.38	42.57	40.97	151	6.04	471	2180	18.84	87.20
5	42.57	45.75	44.16	1116	44.64	1587	2029	63.48	81.16
6	45.75	48.94	47.35	19	0.76	1606	913	64.24	36.52
7	48.94	52.13	50.54	0	0.00	1606	894	64.24	35.76
8	52.13	55.32	53.72	0	0.00	1606	894	64.24	35.76
9	55.32	58.51	56.91	5	0.20	1611	894	64.44	35.76
10	58.51	61.69	60.10	884	35.36	2495	889	99.80	35.56
11	61.69	64.88	63.29	1	0.04	2496	5	99.84	0.20
12	64.88	68.07	66.48	4	0.16	2500	4	100.00	0.16

#Histograma con media y mediana
media <- mean(LATITUDE)
mediana <- median(LATITUDE)

hist(
  LATITUDE,
  breaks = seq(min(LATITUDE), max(LATITUDE) + A, A),
  col = "steelblue",
  main = "Distribución de la Latitud de los puntos geográficos",
  xlab = "Latitud (grados)",
  ylab = "Frecuencia"
)

abline(v = media, col = "red", lwd = 2, lty = 2)
abline(v = mediana, col = "blue", lwd = 2, lty = 2)

legend("topright",
       legend = c(paste("Media =", round(media, 2)),
                  paste("Mediana =", round(mediana, 2))),
       col = c("red", "blue"),
       lty = 2,
       lwd = 2,
       bty = "n")

#Histograma global
hist(
  LATITUDE,
  breaks = seq(min(LATITUDE), max(LATITUDE) + A, A),
  col = "lightcoral",
  main = "Distribución global de la Latitud",
  xlab = "Latitud",
  ylab = "Frecuencia"
)
abline(v = media, col = "red", lwd = 2, lty = 2)
abline(v = mediana, col = "blue", lwd = 2, lty = 2)

legend("topright",
       legend = c(paste("Media =", round(media, 2)),
                  paste("Mediana =", round(mediana, 2))),
       col = c("red", "blue"),
       lty = 2,
       lwd = 2,
       bty = "n")

# Gráfica 3: Distribución porcentual
intervalos <- paste(round(Li, 2), round(Ls, 2), sep = " - ")
pos_media <- (media - min(Li)) / A
pos_mediana <- (mediana - min(Li)) / A

barplot(
  hi,
  names.arg = intervalos,
  col = "darkorange",
  ylim = c(0, max(hi) + 5),
  space = 0,
  cex.names = 0.7,
  ylab = "Frecuencia Relativa (%)",
  xlab = "Intervalos de Latitud (grados)",
  main = "Gráfica 3: Distribución porcentual de LATITUDE por intervalos",
  las = 2,
  border = "white"
)

abline(v = pos_media, col = "red", lwd = 2, lty = 2)
abline(v = pos_mediana, col = "blue", lwd = 2, lty = 2)

legend("topright",
       legend = c(paste("Media =", round(media, 2)),
                  paste("Mediana =", round(mediana, 2))),
       col = c("red", "blue"),
       lty = 2,
       lwd = 2,
       bty = "n")

# Calcular media y mediana 
media_rel_global <- mean(LATITUDE)
mediana_rel_global <- median(LATITUDE)

# Calcular posición exacta en el barplot (eje X basado en índice de barras)
# Se resta el límite inferior y se divide por la amplitud para hallar la posición relativa
pos_media_bar_global <- (media_rel_global - min(Li)) / A
pos_mediana_bar_global <- (mediana_rel_global - min(Li)) / A

barplot(
  hi,   
  names.arg = intervalos,
  col = "mediumpurple",
  ylim = c(0, 100),
  cex.names = 0.7,
  space = 0, # Importante: space=0 hace que cada barra mida exactamente 1 unidad en el eje X
  ylab = "Frecuencia Relativa Acumulada (%)",
  xlab = "Intervalos de Latitud (grados)",
  main = "Gráfica 4: Distribución acumulada porcentual de LATITUDE",
  las = 2,
  border = "white"
)

# Líneas verticales de media y mediana
abline(v = pos_media_bar_global, col = "red", lwd = 2, lty = 2)
abline(v = pos_mediana_bar_global, col = "blue", lwd = 2, lty = 2)

# Leyenda
legend("topright",
       legend = c(paste("Media =", round(media_rel_global, 2)),
                  paste("Mediana =", round(mediana_rel_global, 2))),
       col = c("red", "blue"),
       lty = 2,
       lwd = 2,
       bty = "n")

# Gráfica 5: Ojiva Absoluta
plot(Ls, Niasc, 
     type = "o", 
     pch = 16, 
     col = "blue",
     main = "Gráfica 5: Ojiva de Frecuencias Absolutas Acumuladas \nde los puntos geográficos por Latitud",
     xlab = "Latitud (grados)",
     ylab = "Frecuencia Acumulada Absoluta (Ni)")

lines(Ls, Nidsc, type = "o", pch = 16, col = "red")

legend("topleft",
       c("Ni Ascendente", "Ni Descendente"),
       col = c("blue", "red"),
       pch = 16)

# Gráfica 6: Ojiva Relativa
plot(Ls, Hiasc, 
     type = "o", 
     pch = 16, 
     col = "blue",
     main = "Gráfica 6: Ojiva de Frecuencias Relativas Acumuladas \nde los puntos geográficos por Latitud",
     xlab = "Latitud (grados)",
     ylab = "Frecuencia Acumulada Relativa (%)")

lines(Ls, Hidsc, type = "o", pch = 16, col = "red")

legend("bottomright", 
       c("Hi Ascendente", "Hi Descendente"),
       col = c("blue", "red"), 
       pch = 16)

# Calcular todas las variables necesarias para el boxplot
media_box <- mean(LATITUDE)
mediana_box <- median(LATITUDE)
Q1_box <- quantile(LATITUDE, 0.25)
Q3_box <- quantile(LATITUDE, 0.75)
IQR_box <- IQR(LATITUDE)

# Calcular outliers 
lim_inf_outlier_box <- Q1_box - 1.5 * IQR_box
lim_sup_outlier_box <- Q3_box + 1.5 * IQR_box
outliers_box <- LATITUDE[LATITUDE < lim_inf_outlier_box | LATITUDE > lim_sup_outlier_box]
n_outliers_box <- length(outliers_box)

boxplot(LATITUDE,
        horizontal = TRUE,
        col = "lightblue",
        main = "Gráfica 7: Distribución de la Latitud de los puntos geográficos 
        con detección de valores atípicos",
        xlab = "Latitud (grados)",
        ylab = "",
        border = "darkblue")

# Añadir estadísticos importantes
points(media_box, 1, pch = 23, bg = "red", cex = 1.2)

legend("topright",
       legend = c(paste("Media:", round(media_box, 2)),
                  paste("Mediana:", round(mediana_box, 2)),
                  paste("Q1:", round(Q1_box, 2)),
                  paste("Q3:", round(Q3_box, 2)),
                  paste("Outliers:", n_outliers_box)),
       bty = "n",
       cex = 0.8)

# Calcular indicadores de tendencia central
minimo <- min(LATITUDE)
maximo <- max(LATITUDE)
rango <- maximo - minimo
media <- mean(LATITUDE)
mediana <- median(LATITUDE)
moda <- as.numeric(names(sort(table(LATITUDE), decreasing = TRUE)[1]))

# Crear tabla
tendencia_central <- data.frame(
  Indicador = c("Mínimo", "Media", "Mediana", "Moda", "Máximo", "Rango"),
  Valor = c(
    round(minimo, 4),
    round(media, 4),
    round(mediana, 4),
    round(moda, 4),
    round(maximo, 4),
    round(rango, 4)
  ),
  Unidad = rep("grados", 6),
  Interpretación = c(
    "Valor mínimo observado",
    "Promedio de todos los valores",
    "Valor que divide la muestra en dos partes iguales",
    "Valor más frecuente en la muestra",
    "Valor máximo observado",
    "Diferencia entre el máximo y el mínimo"
  )
)

kable(tendencia_central,
      caption = "Tabla 3: Indicadores de Tendencia Central para la variable LATITUDE en puntos geográficos",
      align = "l")

Tabla 3: Indicadores de Tendencia Central para la variable LATITUDE en puntos geográficos

Indicador	Valor	Unidad	Interpretación
Mínimo	29.8130	grados	Valor mínimo observado
Media	48.7018	grados	Promedio de todos los valores
Mediana	44.0339	grados	Valor que divide la muestra en dos partes iguales
Moda	44.0339	grados	Valor más frecuente en la muestra
Máximo	68.0704	grados	Valor máximo observado
Rango	38.2574	grados	Diferencia entre el máximo y el mínimo

# Calcular indicadores de dispersión
varianza <- var(LATITUDE)
desv_est <- sd(LATITUDE)
CV <- (desv_est / media) * 100

# Interpretación del CV
if(CV < 15) {
  interpretacion_CV <- "BAJA (CV < 15%)"
} else if(CV < 30) {
  interpretacion_CV <- "MODERADA (15% ≤ CV < 30%)"
} else {
  interpretacion_CV <- "ALTA (CV ≥ 30%)"
}

# Crear tabla
dispersion <- data.frame(
  Indicador = c("Varianza", "Desviación Estándar", "Coeficiente de Variación"),
  Valor = c(
    round(varianza, 4),
    round(desv_est, 4),
    paste0(round(CV, 2), "%")
  ),
  Unidad = c("grados²", "grados", ""),
  Interpretación = c(
    "Medida de dispersión al cuadrado",
    "Dispersión promedio respecto a la media",
    paste("Dispersión relativa:", interpretacion_CV)
  )
)

kable(dispersion,
      caption = "Tabla 4: Indicadores de Dispersión para la variable LATITUDE en puntos geográficos",
      align = "l")

Tabla 4: Indicadores de Dispersión para la variable LATITUDE en puntos geográficos

Indicador	Valor	Unidad	Interpretación
Varianza	75.8019	grados²	Medida de dispersión al cuadrado
Desviación Estándar	8.7064	grados	Dispersión promedio respecto a la media
Coeficiente de Variación	17.88%		Dispersión relativa: MODERADA (15% ≤ CV < 30%)

# Calcular indicadores de posición
cuartiles <- quantile(LATITUDE)
Q1 <- cuartiles[2]
Q2 <- cuartiles[3]
Q3 <- cuartiles[4]
IQR_val <- IQR(LATITUDE)

# Detección de outliers
lim_inf_outlier <- Q1 - 1.5 * IQR_val
lim_sup_outlier <- Q3 + 1.5 * IQR_val
outliers <- LATITUDE[LATITUDE < lim_inf_outlier | LATITUDE > lim_sup_outlier]
n_outliers <- length(outliers)
porc_outliers <- round((n_outliers / n) * 100, 2)

# Crear tabla
posicion <- data.frame(
  Indicador = c("Cuartil 1 (Q1)", "Cuartil 2 (Q2 - Mediana)", "Cuartil 3 (Q3)", 
                "Rango Intercuartílico (IQR)", "Límite Inferior Outliers", 
                "Límite Superior Outliers", "Número de Outliers"),
  Valor = c(
    round(Q1, 4),
    round(Q2, 4),
    round(Q3, 4),
    round(IQR_val, 4),
    round(lim_inf_outlier, 4),
    round(lim_sup_outlier, 4),
    paste0(n_outliers, " (", porc_outliers, "%)")
  ),
  Unidad = c(rep("grados", 6), "observaciones"),
  Interpretación = c(
    "25% de datos por debajo de este valor",
    "50% de datos por debajo de este valor (coincide con mediana)",
    "75% de datos por debajo de este valor",
    "Rango del 50% central de datos (Q3 - Q1)",
    "Límite inferior para detección de valores atípicos",
    "Límite superior para detección de valores atípicos",
    "Cantidad y porcentaje de valores atípicos detectados"
  )
)

kable(posicion,
      caption = "Tabla 5: Indicadores de Posición y detección de outliers en LATITUDE",
      align = "l")

Tabla 5: Indicadores de Posición y detección de outliers en LATITUDE

Indicador	Valor	Unidad	Interpretación
Cuartil 1 (Q1)	44.0339	grados	25% de datos por debajo de este valor
Cuartil 2 (Q2 - Mediana)	44.0339	grados	50% de datos por debajo de este valor (coincide con mediana)
Cuartil 3 (Q3)	59.899	grados	75% de datos por debajo de este valor
Rango Intercuartílico (IQR)	15.8651	grados	Rango del 50% central de datos (Q3 - Q1)
Límite Inferior Outliers	20.2363	grados	Límite inferior para detección de valores atípicos
Límite Superior Outliers	83.6966	grados	Límite superior para detección de valores atípicos
Número de Outliers	0 (0%)	observaciones	Cantidad y porcentaje de valores atípicos detectados

# Calcular coeficiente de asimetría de Fisher
asimetria <- moments::skewness(LATITUDE)

if(abs(asimetria) < 0.5) {
  interpretacion_asimetria <- "Distribución simétrica"
} else if(asimetria > 0) {
  interpretacion_asimetria <- "Asimetría positiva (sesgo a la derecha)"
} else {
  interpretacion_asimetria <- "Asimetría negativa (sesgo a la izquierda)"
}

# Curtosis
curtosis <- moments::kurtosis(LATITUDE) - 3

if(abs(curtosis) < 0.5) {
  interpretacion_curtosis <- "Distribución mesocúrtica (normal)"
} else if(curtosis > 0) {
  interpretacion_curtosis <- "Distribución leptocúrtica (picuda)"
} else {
  interpretacion_curtosis <- "Distribución platicúrtica (aplanada)"
}

# Crear tabla
forma <- data.frame(
  Indicador = c("Coeficiente de Asimetría (Fisher)", "Interpretación Asimetría",
                "Coeficiente de Curtosis (Exceso)", "Interpretación Curtosis"),
  Valor = c(
    round(asimetria, 4),
    interpretacion_asimetria,
    round(curtosis, 4),
    interpretacion_curtosis
  ),
  Fórmula = c(
    "g₁ = E[(X-μ)³]/σ³",
    "|g₁| < 0.5: Simétrica; g₁ > 0: Positiva; g₁ < 0: Negativa",
    "g₂ = E[(X-μ)⁴]/σ⁴ - 3",
    "|g₂| < 0.5: Mesocúrtica; g₂ > 0: Leptocúrtica; g₂ < 0: Platicúrtica"
  )
)

kable(forma,
      caption = "Tabla 6: Indicadores de forma de la distribución de LATITUDE",
      align = "l")

Tabla 6: Indicadores de forma de la distribución de LATITUDE

Indicador	Valor	Fórmula
Coeficiente de Asimetría (Fisher)	0.3342	g₁ = E[(X-μ)³]/σ³
Interpretación Asimetría	Distribución simétrica	|g₁| < 0.5: Simétrica; g₁ > 0: Positiva; g₁ < 0: Negativa
Coeficiente de Curtosis (Exceso)	-1.4301	g₂ = E[(X-μ)⁴]/σ⁴ - 3
Interpretación Curtosis	Distribución platicúrtica (aplanada)	|g₂| < 0.5: Mesocúrtica; g₂ > 0: Leptocúrtica; g₂ < 0: Platicúrtica

tabla_resumen <- data.frame(
  Categoría = c("Tendencia Central", "Tendencia Central", "Tendencia Central", 
                "Tendencia Central", "Tendencia Central", "Tendencia Central",
                "Dispersión", "Dispersión", "Dispersión",
                "Posición", "Posición", "Posición", "Posición",
                "Forma", "Forma", "Forma", "Forma"),
  Indicador = c("Mínimo", "Media", "Mediana", "Moda", "Máximo", "Rango",
                "Varianza", "Desviación Estándar", "Coeficiente de Variación",
                "Cuartil 1 (Q1)", "Cuartil 2 (Q2)", "Cuartil 3 (Q3)", 
                "Rango Intercuartílico",
                "Asimetría (g₁)", "Interpretación Asimetría",
                "Curtosis (g₂)", "Interpretación Curtosis"),
  Valor = c(
    round(minimo, 4), round(media, 4), round(mediana, 4), round(moda, 4), 
    round(maximo, 4), round(rango, 4),
    round(varianza, 4), round(desv_est, 4), paste0(round(CV, 2), "%"),
    round(Q1, 4), round(Q2, 4), round(Q3, 4), round(IQR_val, 4),
    round(asimetria, 4), interpretacion_asimetria,
    round(curtosis, 4), interpretacion_curtosis
  ),
  Unidad = c("grados", "grados", "grados", "grados", "grados", "grados",
             "grados²", "grados", "", "grados", "grados", "grados", "grados",
             "", "", "", "")
)

kable(tabla_resumen,
      caption = "Tabla 7: Resumen completo de indicadores estadísticos de LATITUDE",
      align = "l",
      row.names = FALSE)

Tabla 7: Resumen completo de indicadores estadísticos de LATITUDE

Categoría	Indicador	Valor	Unidad
Tendencia Central	Mínimo	29.813	grados
Tendencia Central	Media	48.7018	grados
Tendencia Central	Mediana	44.0339	grados
Tendencia Central	Moda	44.0339	grados
Tendencia Central	Máximo	68.0704	grados
Tendencia Central	Rango	38.2574	grados
Dispersión	Varianza	75.8019	grados²
Dispersión	Desviación Estándar	8.7064	grados
Dispersión	Coeficiente de Variación	17.88%
Posición	Cuartil 1 (Q1)	44.0339	grados
Posición	Cuartil 2 (Q2)	44.0339	grados
Posición	Cuartil 3 (Q3)	59.899	grados
Posición	Rango Intercuartílico	15.8651	grados
Forma	Asimetría (g₁)	0.3342
Forma	Interpretación Asimetría	Distribución simétrica
Forma	Curtosis (g₂)	-1.4301
Forma	Interpretación Curtosis	Distribución platicúrtica (aplanada)