Análisis Estadístico del Año de Recolección

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 <- as.numeric(datos$YEAR_COLL)
year <- na.omit(year)

# 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             3835 13.97   3835  13.97   27449  100.00
## 2   1970-1979  665  2.42   4500  16.39   23614   86.03
## 3   1980-1989 5734 20.89  10234  37.28   22949   83.61
## 4   1990-1999 9864 35.94  20098  73.22   17215   62.72
## 5   2000-2009 4798 17.48  24896  90.70    7351   26.78
## 6   2010-2019 2526  9.20  27422  99.90    2553    9.30
## 7 2020-Actual   27  0.10  27449 100.00      27    0.10

# 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")
  )

Intervalo	ni	hi	Ni_Asc	Hi_Asc	Ni_Desc	Hi_Desc
Tabla Nº1
Distribución de frecuencias del Año de Recolección
	3835	13.97	3835	13.97	27449	100.00
1970-1979	665	2.42	4500	16.39	23614	86.03
1980-1989	5734	20.89	10234	37.28	22949	83.61
1990-1999	9864	35.94	20098	73.22	17215	62.72
2000-2009	4798	17.48	24896	90.70	7351	26.78
2010-2019	2526	9.20	27422	99.90	2553	9.30
2020-Actual	27	0.10	27449	100.00	27	0.10
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,2),
  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 1944.849 2035.56 1991.1    1994     13.8 0.69     -0.63    -0.27

# 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"
  )

Variable	Minimo	Maximo	Media	Mediana	Desv_Est	CV	Asimetria	Curtosis
Tabla Nº2
Indicadores estadísticos de la variable Año de Recolección
YEAR_COLL	1944.849	2035.56	1991.1	1994	13.8	0.69	-0.63	-0.27
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               156 1944.849 2035.56

#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"
  )

Cantidad_Outliers	Minimo	Maximo
Tabla Nº3
Valores atípicos de la variable Año de Recolección
156	1944.849	2035.56
Autor: Grupo

Análisis Estadístico del Año de Recolección

Grupo 3

CARGA DE DATOS Y LIBRERÍAS

TABLA DE DISTRIBUCIÓN DE FRECUENCIA

GRÁFICAS DE DISTRIBUCIÓN DE FRECUENCIA

INDICADORES ESTADÍSTICOS

OUTLIERS

CONCLUSIONES