CARGA DE DATOS Y LIBRERÍAS

# Cargar dataset
datos <- read.csv("C:/Users/Grace/OneDrive - Universidad Central del Ecuador/Documentos/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

clasificacion <- character(length(year))

for(i in seq_along(year)){
  
  if(year[i] >= 1970 & year[i] < 1980){
    clasificacion[i] <- "1970-1979"
  }
  
  if(year[i] >= 1980 & year[i] < 1990){
    clasificacion[i] <- "1980-1989"
  }
  
  if(year[i] >= 1990 & year[i] < 2000){
    clasificacion[i] <- "1990-1999"
  }
  
  if(year[i] >= 2000 & year[i] < 2010){
    clasificacion[i] <- "2000-2009"
  }
  
  if(year[i] >= 2010 & year[i] < 2020){
    clasificacion[i] <- "2010-2019"
  }
  
  if(year[i] >= 2020){
    clasificacion[i] <- "2020-Actual"
  }
}
#   T
tabla <- table(clasificacion)

ni <- as.numeric(tabla)

intervalos <- names(tabla)

total <- sum(ni)

hi <- round((ni/total)*100,2)

Ni_Asc <- cumsum(ni)

Hi_Asc <- cumsum(hi)

Ni_Desc <- rev(cumsum(rev(ni)))

Hi_Desc <- rev(cumsum(rev(hi)))
# TABLA Fin
tabla_final <- data.frame(
  Intervalo = intervalos,
  ni = ni,
  hi = hi,
  Ni_Asc = Ni_Asc,
  Hi_Asc = Hi_Asc,
  Ni_Desc = Ni_Desc,
  Hi_Desc = Hi_Desc
)

tabla_final
##     Intervalo   ni    hi Ni_Asc Hi_Asc Ni_Desc Hi_Desc
## 1             3829 13.96   3829  13.96   27438  100.00
## 2   1970-1979  655  2.39   4484  16.35   23609   86.04
## 3   1980-1989 5733 20.89  10217  37.24   22954   83.65
## 4   1990-1999 9864 35.95  20081  73.19   17221   62.76
## 5   2000-2009 4807 17.52  24888  90.71    7357   26.81
## 6   2010-2019 2533  9.23  27421  99.94    2550    9.29
## 7 2020-Actual   17  0.06  27438 100.00      17    0.06
# TABLA DE DISTRIBUCIÓN FORMATO PROFESIONAL
tabla_final %>%
  gt() %>%
  tab_header(
    title = md("**Tabla Nº1**"),
    subtitle = md("Distribución de frecuencias del Año de Recolección")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo")
  )
Tabla Nº1
Distribución de frecuencias del Año de Recolección
Intervalo ni hi Ni_Asc Hi_Asc Ni_Desc Hi_Desc
3829 13.96 3829 13.96 27438 100.00
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-Actual 17 0.06 27438 100.00 17 0.06
Autor: Grupo

GRÁFICAS DE DISTRIBUCIÓN DE FRECUENCIA

## Histograma de frecuencia absoluta local
barplot(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 = intervalos)

# Histograma de frecuencia absoluta global
barplot(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 = intervalos,
        ylim = c(0, max(ni)+10))

# Frecuencia relativa local
barplot(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 = intervalos)

# Frecuencia relativa global
barplot(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 = intervalos,
        ylim = c(0,100))

# Ojiva combinada Ni
plot(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(intervalos), labels=intervalos)

lines(Ni_Asc,
      col="red",
      type="o")

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

# Ojiva combinada Hi
plot(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(intervalos), labels=intervalos)

lines(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,
  Media = round(media,0),
  Mediana = mediana,
  Desv_Est = round(desv,2),
  CV = CV,
  Asimetria = asimetria,
  Curtosis = curtosis
)

TablaIndicadores
##    Variable Minimo Maximo Media Mediana Desv_Est   CV Asimetria Curtosis
## 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")
  ) %>%
  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 Media Mediana Desv_Est CV Asimetria Curtosis
YEAR_COLL 1945 2024 1991 1994 13.79 0.69 -0.64 -0.28
Autor: Grupo

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.8 indica que se trata de un conjunto homogéneo, debido a que los valores se encuentran poco dispersos alrededor del valor central 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.