Variable-Cuantitativa-Continua-Latitude.R

# ====================================================
#  LIBRERÍAS
# ====================================================
library(readxl)
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, union

library(gt)

# ====================================================
#  CARGAR BASE DE DATOS
# ====================================================
datos_nuevoartes <- read_excel("datos_nuevoartes.xlsx")

# ====================================================
#  VARIABLE: LATITUDE
# ====================================================

latitude <- datos_nuevoartes$latitude
latitude <- latitude[!is.na(latitude)]

# ====================================================
# PARÁMETROS DE CLASIFICACIÓN
# ====================================================

k_lat <- 12
n_lat <- length(latitude)

min_lat <- min(latitude)
max_lat <- max(latitude)

R_lat <- max_lat - min_lat
A_real <- R_lat / k_lat

# ====================================================
# AJUSTE DE AMPLITUD ("BONITA")
# ====================================================

A_lat <- ifelse(
  A_real <= 2, 2,
  ifelse(
    A_real <= 5, 5,
    ifelse(
      A_real <= 10, 10,
      ceiling(A_real / 10) * 10
    )
  )
)

# ====================================================
# LÍMITES DE CLASE
# ====================================================

Li0 <- floor(min_lat / A_lat) * A_lat

Li_lat <- seq(Li0, by = A_lat, length.out = k_lat)
Ls_lat <- Li_lat + A_lat

MC_lat <- round((Li_lat + Ls_lat) / 2, 2)

# ====================================================
# FRECUENCIAS
# ====================================================

ni_lat <- numeric(k_lat)

for (i in 1:k_lat) {
  if (i < k_lat) {
    ni_lat[i] <- sum(latitude >= Li_lat[i] & latitude < Ls_lat[i])
  } else {
    ni_lat[i] <- sum(latitude >= Li_lat[i] & latitude <= max_lat)
  }
}

hi_lat <- round((ni_lat / sum(ni_lat)) * 100, 2)

Ni_asc_lat <- cumsum(ni_lat)
Ni_dsc_lat <- rev(cumsum(rev(ni_lat)))

Hi_asc_lat <- round(cumsum(hi_lat), 2)
Hi_dsc_lat <- round(rev(cumsum(rev(hi_lat))), 2)

# ====================================================
# TABLA DE FRECUENCIAS
# ====================================================

TDF_latitude <- data.frame(
  Li = Li_lat,
  Ls = Ls_lat,
  MC = MC_lat,
  ni = ni_lat,
  hi = hi_lat,
  Ni_asc = Ni_asc_lat,
  Ni_dsc = Ni_dsc_lat,
  Hi_asc = Hi_asc_lat,
  Hi_dsc = Hi_dsc_lat
)

TDF_latitude <- rbind(
  TDF_latitude,
  data.frame(
    Li = "TOTAL",
    Ls = "",
    MC = "",
    ni = sum(ni_lat),
    hi = 100,
    Ni_asc = "",
    Ni_dsc = "",
    Hi_asc = "",
    Hi_dsc = ""
  )
)

# ====================================================
# FORMATO GT
# ====================================================

tabla_latitude <- TDF_latitude %>%
  gt() %>%
  fmt_number(columns = MC, decimals = 2) %>%
  tab_header(
    title = md("Tabla N° 2"),
    subtitle = md("Distribución de frecuencias de Latitude (12 clases)")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo Geología")
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(rows = Li == "TOTAL")
  )

tabla_latitude

Tabla N° 2
Distribución de frecuencias de Latitude (12 clases)
Li	Ls	MC	ni	hi	Ni_asc	Ni_dsc	Hi_asc	Hi_dsc
-50	-40	-45	99	0.90	99	11033	0.9	100
-40	-30	-35	147	1.33	246	10934	2.23	99.1
-30	-20	-25	257	2.33	503	10787	4.56	97.77
-20	-10	-15	158	1.43	661	10530	5.99	95.44
-10	0	-5	498	4.51	1159	10372	10.5	94.01
0	10	5	1015	9.20	2174	9874	19.7	89.5
10	20	15	1394	12.63	3568	8859	32.33	80.3
20	30	25	1842	16.70	5410	7465	49.03	67.67
30	40	35	2554	23.15	7964	5623	72.18	50.97
40	50	45	2603	23.59	10567	3069	95.77	27.82
50	60	55	419	3.80	10986	466	99.57	4.23
60	70	65	47	0.43	11033	47	100	0.43
TOTAL			11033	100.00
Autor: Grupo Geología

# =============================
# HISTOGRAMAS – LATITUDE
# =============================

# HISTOGRAMA LOCAL ni
hist(
  latitude,
  main = "Gráfica Nº 5: Frecuencia de Latitude (Local)",
  ylab = "Cantidad",
  xlab = "Latitude (°)",
  col = "grey"
)

# HISTOGRAMA GLOBAL ni
hist(
  latitude,
  main = "Gráfica Nº 6: Frecuencia de Latitude (Global)",
  ylab = "Cantidad",
  xlab = "Latitude (°)",
  col = "grey",
  ylim = c(0, length(latitude))
)

# HISTOGRAMA LOCAL hi
barplot(
  TDF_latitude$hi[TDF_latitude$Li != "TOTAL"],
  space = 0,
  main = "Gráfica Nº 7: Porcentaje de Latitude (Local)",
  ylab = "Porcentaje (%)",
  xlab = "Marca de Clase (°)",
  col = "grey",
  names.arg = TDF_latitude$MC[TDF_latitude$Li != "TOTAL"]
)

# HISTOGRAMA GLOBAL hi
barplot(
  TDF_latitude$hi[TDF_latitude$Li != "TOTAL"],
  space = 0,
  main = "Gráfica Nº 8: Porcentaje de Latitude (Global)",
  ylab = "Porcentaje (%)",
  xlab = "Marca de Clase (°)",
  col = "grey",
  names.arg = TDF_latitude$MC[TDF_latitude$Li != "TOTAL"],
  ylim = c(0, 100)
)

plot(
  Ls_lat,
  Ni_asc_lat,
  type = "o",
  pch = 19,
  col = "blue",
  main = "Ojiva combinada de Latitude",
  xlab = "Límites de clase (°)",
  ylab = "Frecuencia acumulada"
)

lines(
  Li_lat,
  Ni_dsc_lat,
  type = "o",
  pch = 17,
  col = "red"
)

legend(
  "right",
  legend = c("Ojiva ascendente (Ni ≤)", "Ojiva descendente (Ni ≥)"),
  col = c("blue", "red"),
  pch = c(19, 17),
  lty = 1,
  cex = 0.8,
  bty = "b"
)

boxplot(
  latitude,
  horizontal = TRUE,
  col = "grey",
  border = "black",
  main = "Diagrama de caja de Latitude",
  xlab = "Latitude (°)",
  outline = TRUE,
  pch = 19,
  outcol = "red"
)

ri <- -90
rs <-  90
x  <- mean(latitude)
Me <- median(latitude)

Mo <- as.numeric(
  names(sort(table(round(latitude, 1)), decreasing = TRUE)[1])
)

sd_lat <- sd(latitude)
CV <- (sd_lat / x) * 100

As <- mean((latitude - x)^3) / sd_lat^3
K  <- mean((latitude - x)^4) / sd_lat^4 - 3

TablaIndicadores_latitude <- data.frame(
  Var = "Latitude",
  ri = ri,
  rs = rs,
  x  = round(x, 2),
  Me = round(Me, 2),
  Mo = round(Mo, 2),
  sd = round(sd_lat, 2),
  CV = round(CV, 2),
  As = round(As, 2),
  K  = round(K, 2)
)

tabla_latitude_indicadores <- TablaIndicadores_latitude %>%
  gt() %>%
  tab_header(
    title = md("Tabla N° X"),
    subtitle = md("Indicadores estadísticos de la variable Latitude")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo Geología")
  )

tabla_latitude_indicadores

Tabla N° X
Indicadores estadísticos de la variable Latitude
Var	ri	rs	x	Me	Mo	sd	CV	As	K
Latitude	-90	90	25.88	30.53	45.6	20.42	78.88	-1.12	1.1
Autor: Grupo Geología

#====================================================
# DETECCIÓN Y UBICACIÓN DE OUTLIERS – LATITUDE
# ====================================================

# 1. Parámetros estadísticos
Q1_lat <- quantile(latitude, 0.25)
Q3_lat <- quantile(latitude, 0.75)
IQR_lat <- Q3_lat - Q1_lat

# 2. Definición de Rangos Críticos (Vallas)
lim_inf_valla <- Q1_lat - 1.5 * IQR_lat
lim_sup_valla <- Q3_lat + 1.5 * IQR_lat

# 3. Identificación de Outliers por ubicación
outliers_bajos <- latitude[latitude < lim_inf_valla]
outliers_altos <- latitude[latitude > lim_sup_valla]

# 4. Creación de Tabla Resumen de Rangos
Tabla_Rangos_Outliers <- data.frame(
  Zona = c("Outliers Inferiores (Sur)", "Datos Normales", "Outliers Superiores (Norte)"),
  Rango_Aceptado = c(
    paste("<", round(lim_inf_valla, 4)),
    paste(round(lim_inf_valla, 4), "a", round(lim_sup_valla, 4)),
    paste(">", round(lim_sup_valla, 4))
  ),
  Cantidad_Puntos = c(length(outliers_bajos), n_lat - length(outliers_bajos) - length(outliers_altos), length(outliers_altos))
)

# ====================================================
# FORMATO GT PARA LOS RANGOS
# ====================================================

tabla_outliers_final <- Tabla_Rangos_Outliers %>%
  gt() %>%
  tab_header(
    title = md("*Tabla 3*"),
    subtitle = md("*Ubicación de Outliers y Rangos de Control para Latitude*")
  ) %>%
  cols_label(
    Zona = "Zona de Distribución",
    Rango_Aceptado = "Rango Numérico (°)",
    Cantidad_Puntos = "N° de Registros"
  ) %>%
  tab_style(
    style = cell_fill(color = "mistyrose"),
    locations = cells_body(rows = c(1, 3)) # Resalta las zonas de outliers
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo Geología | Método de Tukey (1.5 * IQR)")
  )

tabla_outliers_final

Tabla 3
Ubicación de Outliers y Rangos de Control para Latitude
Zona de Distribución	Rango Numérico (°)	N° de Registros
Outliers Inferiores (Sur)	< -26.5054	287
Datos Normales	-26.5054 a 81.2892	10746
Outliers Superiores (Norte)	> 81.2892	0
Autor: Grupo Geología | Método de Tukey (1.5 * IQR)