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 y limpiar la variable → ahora se llama "year"
year <- round(as.numeric(datos$YEAR_COLL))

# Eliminar NA y años irreales
year <- na.omit(year)
year <- year[year <= 2024]

# ==========================================================
# ESTADÍSTICA DE LOS INTERVALOS
# ==========================================================

# Número de observaciones
n <- length(year)

# Regla de Sturges
k <- floor(1 + 3.322 * log10(n))
k
## [1] 15
# Rango
R <- max(year) - min(year)
R
## [1] 79
# Amplitud teórica
A <- ceiling(R / k)
A
## [1] 6
cat("Número de observaciones =", n, "\n")
## Número de observaciones = 27438
cat("Número de clases según Sturges =", k, "\n")
## Número de clases según Sturges = 15
cat("Rango =", R, "\n")
## Rango = 79
cat("Amplitud teórica =", A, "\n")
## Amplitud teórica = 6
# 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

YEAR_COLL es una variable cuantitativa discreta. Aplicando Sturges se obtuvo un número teórico de clases k.Para facilitar la representación gráfica, se agruparon los años en intervalos de 10 años (9 clases).

# Agrupar la variable en intervalos de décadas

clasificacion <- character(length(year))

for(i in seq_along(year)){

  if(year[i] >= 1940 & year[i] < 1950){
    clasificacion[i] <- "1940-1949"
  }

  else if(year[i] >= 1950 & year[i] < 1960){
    clasificacion[i] <- "1950-1959"
  }

  else if(year[i] >= 1960 & year[i] < 1970){
    clasificacion[i] <- "1960-1969"
  }

  else if(year[i] >= 1970 & year[i] < 1980){
    clasificacion[i] <- "1970-1979"
  }

  else if(year[i] >= 1980 & year[i] < 1990){
    clasificacion[i] <- "1980-1989"
  }

  else if(year[i] >= 1990 & year[i] < 2000){
    clasificacion[i] <- "1990-1999"
  }

  else if(year[i] >= 2000 & year[i] < 2010){
    clasificacion[i] <- "2000-2009"
  }

  else if(year[i] >= 2010 & year[i] < 2020){
    clasificacion[i] <- "2010-2019"
  }

  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-1949",
  "1950-1959",
  "1960-1969",
  "1970-1979",
  "1980-1989",
  "1990-1999",
  "2000-2009",
  "2010-2019",
  "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
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

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-1949 2 0.01 2 0.01 27438 100
1950-1959 200 0.73 202 0.74 27436 99.99
1960-1969 3627 13.22 3829 13.96 27236 99.26
1970-1979 655 2.39 4484 16.35 23609 86.04
1980-1989 5733 20.89 10217 37.24 22954 83.65
1990-1999 9864 35.95 20081 73.19 17221 62.76
2000-2009 4807 17.52 24888 90.71 7357 26.81
2010-2019 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",
        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",
        xlab = "Intervalos de Año",
        ylab = "Cantidad",
        names.arg = orden,
        ylim = c(0, total))

# Histograma de 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",
        col = "gray",
        xlab = "Intervalos de Año",
        ylab = "Porcentaje",
        names.arg = orden)

# Histograma de 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",
        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")

# Calcular histograma con frecuencia absoluta
h <- hist(year,
          breaks = c(1940, 1950, 1960, 1970, 1980, 1990, 2000, 2010, 2020, 2025),
          probability = FALSE,     # ← FALSE = frecuencia absoluta (ni)
          plot = FALSE)
## Warning in hist.default(year, breaks = c(1940, 1950, 1960, 1970, 1980, 1990, :
## argument 'probability' is not made use of
# Graficar histograma
hist(year,
     breaks = c(1940, 1950, 1960, 1970, 1980, 1990, 2000, 2010, 2020, 2025),
     probability = FALSE,
     main = "Gráfica Nº8: Histograma y Diagrama de Caja del
     Año de Recolección de Sedimentos Marinos",
     xlab = "Intervalos de Año",
     ylab = "Frecuencia",           # ← Cambiado a Frecuencia
     col = "lightgray",
     border = "black",
     xaxt = "n",
     ylim = c(0, max(h$counts)*1.25))
## Warning in plot.histogram(r, freq = freq1, col = col, border = border, angle =
## angle, : the AREAS in the plot are wrong -- rather use 'freq = FALSE'
# Etiquetas del eje X
axis(1, 
     at = c(1945, 1955, 1965, 1975, 1985, 1995, 2005, 2015, 2022),
     labels = c(
  "1940-49",
  "1950-59",
  "1960-69",
  "1970-79",
  "1980-89",
  "1990-99",
  "2000-09",
  "2010-19",
  "2020-24"
),
     las = 2, cex.axis = 0.68)

# Boxplot
altura_caja <- max(h$counts) * 0.48

boxplot(year,
        horizontal = TRUE,
        add = TRUE,
        at = altura_caja,
        axes = FALSE,
        boxwex = max(h$counts) * 0.40,
        col = rgb(0, 0.65, 1, 0.55),
        border = "darkblue",
        lwd = 2.2,
        outline = TRUE,
        outpch = 19,
        outcol = "red")

grid(col = "gray70", lty = "dotted")

INDICADORES ESTADÍSTICOS

# Cálculo de indicadores

media <- mean(year)
media
## [1] 1991.085
mediana <- median(year)
mediana
## [1] 1994
desv <- sd(year)
desv
## [1] 13.78532
CV <- round((desv/media)*100,2)
CV
## [1] 0.69
asimetria <- round(skewness(year),2)
asimetria
## [1] -0.64
curtosis <- round(kurtosis(year),2)
curtosis
## [1] -0.28
minimo <- min(year)
minimo
## [1] 1945
maximo <- max(year)
maximo
## [1] 2024
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 y el coeficiente de variación de 0.69 % indican una baja dispersión y una alta homogeneidad de los datos. La asimetría negativa (-0.64) evidencia la presencia de registros antiguos que influyen en el extremo izquierdo de la distribución. La acumulación de valores se encuentra en la parte alta de la variable, lo que demuestra 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.