CARGA DE DATOS Y LIBRERÍAS

# Cargar dataset
datos <- read.csv("C:/Users/Grace/Downloads/dataset_geologico_limpio_80.csv",
                  header = TRUE,
                  sep = ",",
                  dec = ".")

# Extraer variable
year <- round(as.numeric(datos$YEAR_COLL))
# eliminar NA
year <- na.omit(year)
# eliminar años irreales (mayores al actual)
year <- year[year <= 2024]
# Librerías
library(gt)
library(dplyr)
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(e1071)

TABLA DE DISTRIBUCIÓN DE FRECUENCIA

# TABLA DE DISTRIBUCIÓN DE FRECUENCIA

# Debido a que existen numerosos registros del año de recolección,
# se decidió agruparlos en intervalos, convirtiendo la variable en continua.

# Agrupar la variable en intervalos
clasificacion <- character(length(year))

for(i in seq_along(year)){
  if(year[i] >= 1940 & year[i] < 1950){
    clasificacion[i] <- "[1940 , 1950)"
  } else if(year[i] >= 1950 & year[i] < 1960){
    clasificacion[i] <- "[1950 , 1960)"
  } else if(year[i] >= 1960 & year[i] < 1970){
    clasificacion[i] <- "[1960 , 1970)"
  } else if(year[i] >= 1970 & year[i] < 1980){
    clasificacion[i] <- "[1970 , 1980)"
  } else if(year[i] >= 1980 & year[i] < 1990){
    clasificacion[i] <- "[1980 , 1990)"
  } else if(year[i] >= 1990 & year[i] < 2000){
    clasificacion[i] <- "[1990 , 2000)"
  } else if(year[i] >= 2000 & year[i] < 2010){
    clasificacion[i] <- "[2000 , 2010)"
  } else if(year[i] >= 2010 & year[i] < 2020){
    clasificacion[i] <- "[2010 , 2020)"
  } else if(year[i] >= 2020){
    clasificacion[i] <- "[2020 , 2024]"
  } else {
    clasificacion[i] <- NA
  }
}

# Quitar posibles NA de la clasificación
clasificacion <- na.omit(clasificacion)

# Orden adecuado
orden <- c("[1940 , 1950)",
           "[1950 , 1960)",
           "[1960 , 1970)",
           "[1970 , 1980)",
           "[1980 , 1990)",
           "[1990 , 2000)",
           "[2000 , 2010)",
           "[2010 , 2020)",
           "[2020 , 2024]")

clasificacion <- factor(clasificacion, levels = orden)

# 4) Frecuencias simples
ni <- table(clasificacion)
total <- sum(ni)
hi <- round(as.numeric(ni) / total * 100, 2)

# 5) Acumulados ascendentes
Ni_Asc <- cumsum(ni)
Hi_Asc <- cumsum(hi)

# 6) Acumulados descendentes
Ni_Desc <- rev(cumsum(rev(ni)))
Hi_Desc <- rev(cumsum(rev(hi)))

# 7) Tabla final (AQUÍ FORZAMOS A QUE TODO SEA NUMÉRICO PURO)
tabla_final <- data.frame(
  Intervalo = orden,
  ni = as.numeric(ni),
  hi = as.numeric(hi),
  Ni_Asc = as.numeric(Ni_Asc),
  Hi_Asc = round(as.numeric(Hi_Asc), 3),
  Ni_Desc = as.numeric(Ni_Desc),
  Hi_Desc = round(as.numeric(Hi_Desc), 3)
)

# Crear fila total
fila_total <- data.frame(
  Intervalo = "TOTAL",
  ni = sum(ni),
  hi = round(sum(hi), 2),
  Ni_Asc = "",
  Hi_Asc = "",
  Ni_Desc = "",
  Hi_Desc = ""
)

# Unir a la tabla
tabla_final <- rbind(tabla_final, fila_total)
# TABLA DE DISTRIBUCIÓN DE CANTIDAD FINAL

# TABLA GT
TablaDisc <- tabla_final %>%
  gt() %>%
  tab_header(
    title = md("**Tabla Nº. 1**"),
    subtitle = md("**Tabla de distribución de cantidad de los años<br>de recolección de sedimentos marinos**")
  ) %>%
  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)
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(
      rows = Intervalo == "TOTAL"
    )
  )

TablaDisc
Tabla Nº. 1
Tabla de distribución de cantidad de los años
de recolección de sedimentos marinos
Intervalo ni hi Ni_Asc Hi_Asc Ni_Desc Hi_Desc
[1940 , 1950) 2 0.01 2 0.01 27438 100
[1950 , 1960) 200 0.73 202 0.74 27436 99.99
[1960 , 1970) 3627 13.22 3829 13.96 27236 99.26
[1970 , 1980) 655 2.39 4484 16.35 23609 86.04
[1980 , 1990) 5733 20.89 10217 37.24 22954 83.65
[1990 , 2000) 9864 35.95 20081 73.19 17221 62.76
[2000 , 2010) 4807 17.52 24888 90.71 7357 26.81
[2010 , 2020) 2533 9.23 27421 99.94 2550 9.29
[2020 , 2024] 17 0.06 27438 100 17 0.06
TOTAL 27438 100.00
Autor: Grupo 2

GRÁFICAS DE DISTRIBUCIÓN DE FRECUENCIA

# Histograma de frecuencia absoluta local
barplot(as.numeric(ni),
        space = 0,
        col = "gray",
        main = "Gráfica Nº1: Distribución de cantidad del
        Año de Recolección de Sedimentos Marinos (Local)",
        xlab = "Intervalos de Año",
        ylab = "Cantidad",
        names.arg = orden)

# Histograma de frecuencia absoluta global 
barplot(as.numeric(ni),
        space = 0,
        col = "gray",
        main = "Gráfica Nº2: Distribución de cantidad del
        Año de Recolección de Sedimentos Marinos (Global)",
        xlab = "Intervalos de Año",
        ylab = "Cantidad",
        names.arg = orden,
        ylim = c(0, total))   

# Frecuencia relativa local
barplot(as.numeric(hi),
        space = 0,
        main = "Gráfica Nº3: Distribución de cantidad en porcentaje del
        Año de Recolección de Sedimentos Marinos (Local)",
        col = "gray",
        xlab = "Intervalos de Año",
        ylab = "Porcentaje",
        names.arg = orden)

# Frecuencia relativa global
barplot(as.numeric(hi),
        space = 0,
        main = "Gráfica Nº4: Distribución de cantidad en porcentaje del
        Año de Recolección de Sedimentos Marinos (Global)",
        col = "gray",
        xlab = "Intervalos de Año",
        ylab = "Porcentaje",
        names.arg = orden,
        ylim = c(0, 100))

# Ojiva combinada Ni
plot(as.numeric(Ni_Desc), type="o",
     main="Gráfica Nº5: Ojiva combinada del Año de Recolección (Ni)",
     ylab="Cantidad acumulada",
     col="blue",
     xlab="Intervalos",
     xaxt="n")

axis(1, at=1:length(orden), labels=orden)

lines(as.numeric(Ni_Asc),
      col="red",
      type="o")

legend("topleft",
       legend=c("Descendente","Ascendente"),
       col=c("blue","red"),
       lty=1,
       pch=1)

# Ojiva combinada Hi
plot(as.numeric(Hi_Desc), type="o",
     main="Gráfica Nº6: Ojiva combinada del Año de Recolección (Hi)",
     ylab="Porcentaje acumulado",
     col="blue",
     xlab="Intervalos",
     xaxt="n",
     ylim=c(0, 100))

axis(1, at=1:length(orden), labels=orden)

lines(as.numeric(Hi_Asc),
      col="red",
      type="o")

legend("topleft",
       legend=c("Descendente","Ascendente"),
       col=c("blue","red"),
       lty=1,
       pch=1)

# DIAGRAMA DE CAJA
boxplot(year,
        horizontal = TRUE,
        main = "Gráfica Nº7: Distribución de cantidad del
        Año de Recolección de Sedimentos Marinos",
        xlab = "Año",
        col = "lightblue")

INDICADORES ESTADÍSTICOS

# Cálculo de indicadores

media <- mean(year)
mediana <- median(year)
desv <- sd(year)

CV <- round((desv/media)*100,2)

asimetria <- round(skewness(year),2)
curtosis <- round(kurtosis(year),2)

minimo <- min(year)
maximo <- max(year)

TablaIndicadores <- data.frame(
  Variable = "YEAR_COLL",
  Minimo = minimo,
  Maximo = maximo,
  x  = round(media,0),
  Me = mediana,
  sd = round(desv,2),
  Cv = CV,
  As = asimetria,
  K = curtosis
)

TablaIndicadores
##    Variable Minimo Maximo    x   Me    sd   Cv    As     K
## 1 YEAR_COLL   1945   2024 1991 1994 13.79 0.69 -0.64 -0.28
# Tabla Mejorada
TablaIndicadores %>%
  gt() %>%
  tab_header(
    title = md("**Tabla Nº2**"),
    subtitle = md("Indicadores estadísticos de la variable Año de Recolección")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 2")
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    row.striping.include_table_body = TRUE,
    table_body.hlines.color = "gray"
  )
Tabla Nº2
Indicadores estadísticos de la variable Año de Recolección
Variable Minimo Maximo x Me sd Cv As K
YEAR_COLL 1945 2024 1991 1994 13.79 0.69 -0.64 -0.28
Autor: Grupo 2

OUTLIERS

outliers <- boxplot.stats(year)$out

num_outliers <- length(outliers)

min_out <- ifelse(num_outliers > 0, min(outliers), NA)
max_out <- ifelse(num_outliers > 0, max(outliers), NA)

TablaOutliers <- data.frame(
  Cantidad_Outliers = num_outliers,
  Minimo = min_out,
  Maximo = max_out
)

TablaOutliers
##   Cantidad_Outliers Minimo Maximo
## 1               147   1945   1957
#Tabla Mejorada 
TablaOutliers %>%
  gt() %>%
  tab_header(
    title = md("**Tabla Nº3**"),
    subtitle = md("Valores atípicos de la variable Año de Recolección")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo")
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    row.striping.include_table_body = TRUE,
    table_body.hlines.color = "gray"
  )
Tabla Nº3
Valores atípicos de la variable Año de Recolección
Cantidad_Outliers Minimo Maximo
147 1945 1957
Autor: Grupo

CONCLUSIÓN

La variable Año de Recolección presenta valores que fluctúan entre 1945 y 2024, con una concentración en torno a la mediana de 1994. La desviación estándar de 13.79 indica que se trata de un conjunto homogéneo, influenciado por la presencia de valores atípicos antiguos ubicados en el extremo izquierdo de la distribución. La acumulación de valores se encuentra en la parte alta de la variable, lo que evidencia que la mayoría de las recolecciones se realizaron en periodos recientes. Por todo lo anterior mencionado, el comportamiento de la variable es medianamente beneficioso, debido a que los registros modernos cuentan con información geológica más confiable y mejor documentada.