ANÁLISIS ESTADÍSTICO

CARGA DE DATOS Y LIBRERÍAS

CARGA DE DATOS

setwd("~/UNI/ESTADISTICA")
datos <- read.csv("Depositos_Sulfuro.csv", header = TRUE, sep = ";", dec = ".")

# Extraer y dejar solo datos válidos 

disc <- as.numeric(datos$discdate)
disc <- na.omit(disc)

CARGA DE LIBRERIAS

#Carga de librerias
library(gt)
library(dplyr)
library(knitr)
library(e1071)

TABLA DE DISTRIBUCIÓN DE FRECUENCIA

TABLA DE DISTRIBUCION DE FRECUENCIA

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

#Agrupar la variable en intervalos

clasificacion <- character(length(disc))

for(i in seq_along(disc)){
  if(disc[i] >= -3000 & disc[i] < -2500){
    clasificacion[i] <- "[-3000 , -2500)"
  } else if(disc[i] >= -2500 & disc[i] < -2000){
    clasificacion[i] <- "[-2500 , -2000)"
  } else if(disc[i] >= -2000 & disc[i] < -1500){
    clasificacion[i] <- "[-2000 , -1500)"
  } else if(disc[i] >= -1500 & disc[i] < -1000){
    clasificacion[i] <- "[-1500 , -1000)"
  } else if(disc[i] >= -1000 & disc[i] < -500){
    clasificacion[i] <- "[-1000 , -500)"
  } else if(disc[i] >= -500 & disc[i] < 0){
    clasificacion[i] <- "[-500 , 0)"
  } else if(disc[i] >= 0 & disc[i] < 500){
    clasificacion[i] <- "[0 , 500)"
  } else if(disc[i] >= 500 & disc[i] < 1000){
    clasificacion[i] <- "[500 , 1000)"
  } else if(disc[i] >= 1000 & disc[i] < 1500){
    clasificacion[i] <- "[1000 , 1500)"
  } else if(disc[i] >= 1500 & disc[i] < 2000){
    clasificacion[i] <- "[1500 , 2000)"
  } else if(disc[i] >= 2000 & disc[i] <= 2200){
    clasificacion[i] <- "[2000 , 2200]"
  } else {
    clasificacion[i] <- NA
  }
}

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

#Orden adecuado

orden <- c("[-3000 , -2500)",
           "[-2500 , -2000)",
           "[-2000 , -1500)",
           "[-1500 , -1000)",
           "[-1000 , -500)",
           "[-500 , 0)",
           "[0 , 500)",
           "[500 , 1000)",
           "[1000 , 1500)",
           "[1500 , 2000)",
           "[2000 , 2200]")

clasificacion <- factor(clasificacion, levels = orden)



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

# 5) Acumuladas ascendente
Ni_Asc <- cumsum(ni)
Hi_Asc <- cumsum(hi)

# 6) Acumuladas descendente
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 = hi,
  Ni_Asc = as.numeric(Ni_Asc),
  Hi_Asc = round(Hi_Asc, 3),
  Ni_Desc = as.numeric(Ni_Desc),
  Hi_Desc = round(Hi_Desc, 3)
)

# Verificar que las proporciones sumen 100
sum(tabla_final$hi)     
## [1] 100
tail(tabla_final$Hi_Asc,1)  
## [1] 100
head(tabla_final$Hi_Desc,1) 
## [1] 100
# Calcular sumatorias simples
suma_ni <- sum(tabla_final$ni)
suma_hi <- sum(tabla_final$hi)

Fila total de las sumas de ni y hi

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

# Unir a la tabla
tabla_final <- rbind(tabla_final, fila_total)

tabla_final
##          Intervalo  ni     hi Ni_Asc Hi_Asc Ni_Desc Hi_Desc
## 1  [-3000 , -2500)   4   0.49      4   0.49     823     100
## 2  [-2500 , -2000)   1   0.12      5   0.61     819   99.51
## 3  [-2000 , -1500)   3   0.36      8   0.97     818   99.39
## 4  [-1500 , -1000)   3   0.36     11   1.33     815   99.03
## 5   [-1000 , -500)  12   1.46     23   2.79     812   98.67
## 6       [-500 , 0)   2   0.24     25   3.03     800   97.21
## 7        [0 , 500)  17   2.07     42    5.1     798   96.97
## 8     [500 , 1000)   0   0.00     42    5.1     781    94.9
## 9    [1000 , 1500)   5   0.61     47   5.71     781    94.9
## 10   [1500 , 2000) 768  93.32    815  99.03     776   94.29
## 11   [2000 , 2200]   8   0.97    823    100       8    0.97
## 12           TOTAL 823 100.00      -      -       -       -

TABLA DE DISTRIBUCIÓN DE FRECUENCIA FINAL

# TABLA GT
TablaDisc <- tabla_final %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nº. 1*"),
    subtitle = md("**Tabla de distribución de frecuencias simples y acumuladas  
                de los años de descubrimiento de los depósitos masivos de sulfuros volcánicos**")
  ) %>%
  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),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black"
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(
      rows = Intervalo == "TOTAL"   
    )
  )

TablaDisc
Tabla Nº. 1
Tabla de distribución de frecuencias simples y acumuladas
de los años de descubrimiento de los depósitos masivos de sulfuros volcánicos
Intervalo ni hi Ni_Asc Hi_Asc Ni_Desc Hi_Desc
[-3000 , -2500) 4 0.49 4 0.49 823 100
[-2500 , -2000) 1 0.12 5 0.61 819 99.51
[-2000 , -1500) 3 0.36 8 0.97 818 99.39
[-1500 , -1000) 3 0.36 11 1.33 815 99.03
[-1000 , -500) 12 1.46 23 2.79 812 98.67
[-500 , 0) 2 0.24 25 3.03 800 97.21
[0 , 500) 17 2.07 42 5.1 798 96.97
[500 , 1000) 0 0.00 42 5.1 781 94.9
[1000 , 1500) 5 0.61 47 5.71 781 94.9
[1500 , 2000) 768 93.32 815 99.03 776 94.29
[2000 , 2200] 8 0.97 823 100 8 0.97
TOTAL 823 100.00 - - - -
Autor: Grupo 2

GRÁFICAS DE DISTRIBUCIÓN DE FRECUENCIA

Histograma de frecuencia absoluta local

hist(disc, main="Grafica Nº1: Distrribucion de frecuencia absoluta local del año
     de descubrimiento de los depositos masivos de sulfuros volcanicos ",
        col="gray",
        ylab="Cantidad",
        xlab = "Año de descubrimiento",
        cex.names = 0.6)

Histograma de frecuencia absoluta global

hist(disc, main="Grafica Nº2: Distribucion de frecuencia absoluta global del año 
     de descubrimiento los depositos masivos de sulfuros volcanicos ",
        col="gray",
        xlab="Año de descubrimiento",
        ylab="Cantidad",
        cex.names = 0.6,
        ylim=c(0,800))

Histograma de frecuencia relativa local

etiquetas_x <- c(-3000, -2500, -2000, -1500, -1000, -500,
                 0, 500, 1000, 1500, 2000)
hi_plot <- tabla_final$hi[tabla_final$Intervalo != "TOTAL"]

barplot(hi_plot,
        main = "Grafica Nº3: Distribucion de frecuencia relativa local del año
        de descubrimiento  de los depósitos masivos de sulfuros volcánicos ",
        col="gray", 
        space=0,
        las=1,
        xlab="Año de descubrimiento",
        ylab="Porcentaje",
        names.arg = etiquetas_x,
        cex.names = 0.6)

Histograma de frecuencia relativa global

# Filtrar los datos SIN la fila TOTAL
hi_plot <- tabla_final$hi[tabla_final$Intervalo != "TOTAL"]

barplot(hi_plot,
        space = 0,
        main="Grafica Nº4: Distribucion de frecuencia relativa global del año 
        de descubrimiento de los depósitos masivos de sulfuros volcánicos ",
        col = "gray",
        las = 1,
        xlab = "Año de descubrimiento",
        ylab = "Porcentaje",
        names.arg = etiquetas_x,
        ylim = c(0,100),
        cex.names = 0.6)

Ojivas combinadas Ni

x_intervalos <- c(-3000, -2500, -2000, -1500, -1000, -500,
                  0, 500, 1000, 1500, 2000)

plot(x = x_intervalos,
     y = Ni_Asc,
     type = "o",
     col = "blue",
     main = "Grafica Nº5: Ojiva combinada del año de descubrimiento\n(Ni)",
     xlab = "Año de descubrimiento",
     ylab = "Frecuencia acumulada",
     las = 2
)

lines(x = x_intervalos,
      y = Ni_Desc,
      type = "o",
      col = "red")

Ojivas combinadas Hi

plot(x = x_intervalos,
     y = Hi_Asc,
     type = "o",
     col = "blue",
     main = "Grafica Nº6: Ojiva combinada del año de descubrimiento\n(Hi)",
     xlab = "Año de descubrimiento",
     ylab = "Porcentaje acumulado",
     las = 2,
     ylim = c(0, 100)
)

lines(x = x_intervalos,
      y = Hi_Desc,
      type = "o",
      col = "black")

DIAGRAMA DE CAJA

boxplot(disc,
        horizontal = TRUE,
        col = "blue",
        main = "Gráfica Nº7: Distribución de frecuencia del año de descubrimiento 
        de depósitos masivos de sulfuros volcánicos",
        xlab = "Año de descubrimiento")

INDICADORES ESTADISTICOS Y OUTLIERS

Ver los cuartiles

summary(disc)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   -3000    1896    1947    1785    1965    2004

Indicadores Estadisticos

POSICION

#MEDIA ARITMETICA
x<-mean(disc)
x
## [1] 1785.355
#MEDIANA ARITMETICA

ri<-min(disc)
rs<-max(disc)
Me<-median(disc)
Me
## [1] 1947

DISPERSION

#DESVIACIÓN ESTÁNDAR
sd<-sd(disc)
sd
## [1] 639.8237
#COEFICIENTE DE VARIACIÓN
CV <- ((sd / x) * 100)
CV
## [1] 35.83734

FORMA

#COEFICIENTE DE ASIMETRÍA
As<-skewness(disc)
As
## [1] -4.949028
#COEFICIENTE DE CURTOSIS
K<-kurtosis(disc)
K
## [1] 26.18935

TABLA DE INDICADORES ESTADISTICOS

Variable<-c("Año de descubrimiento")
TablaIndicadores<-data.frame(Variable,ri,rs,round(x,2),Me,round(sd,2), round(CV,2), round(As,2),round(K,2))
colnames(TablaIndicadores)<-c("Variable","minimo","máximo","x","Me","sd","Cv (%)","As","K")

kable(TablaIndicadores, format = "markdown", caption = "Tabla N°3. Indicadores estadíticos de la variable año de descubrimiento de los depositos masivos de sulfuros volcanicos")
Tabla N°3. Indicadores estadíticos de la variable año de descubrimiento de los depositos masivos de sulfuros volcanicos
Variable minimo máximo x Me sd Cv (%) As K
Año de descubrimiento -3000 2004 1785.35 1947 639.82 35.84 -4.95 26.19

TABLA DE OUTLIERS

outliers<-boxplot.stats(disc)$out 
# Contar los valores atípicos 
num_outliers <- length(outliers) 
num_outliers
## [1] 87
minoutliers<-min(outliers)
minoutliers
## [1] -3000
maxoutliers<-max(outliers)
maxoutliers
## [1] 1793
TablaOutliers<-data.frame(num_outliers,minoutliers,maxoutliers)
colnames(TablaOutliers)<-c("Outliers","Mínimo","Máximo")
kable(TablaOutliers, format = "markdown", caption = "Tabla N°4: Outliers 
      de la variable año de descubrimiento de los depositos masivos de sulfuros
      volcanicos).")
Tabla N°4: Outliers de la variable año de descubrimiento de los depositos masivos de sulfuros volcanicos).
Outliers Mínimo Máximo
87 -3000 1793

CONCLUSIÓN

CONCLUSÍON

La variable año de descubrimiento presenta valores que fluctúan entre –3000 y 2004, con una concentración en torno a la mediana de 1947. La desviación estándar de 639.82 indica que se trata de un conjunto heterogéneo, influenciado por la presencia de valores atípicos muy 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 los descubrimientos 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.