Análisis Estadístico Arcilla

CARGA DE DATOS Y LIBRERÍAS

# CARGA DE DATOS
datos <- read.csv("C:/Users/Grace/OneDrive - Universidad Central del Ecuador/Documentos/dataset_geologico_limpio_80.csv",
                  header = TRUE,
                  sep = ",",
                  dec = ".",
                  stringsAsFactors = FALSE)

# LIMPIEZA DE LA VARIABLE
arcilla_raw <- as.numeric(gsub("[^0-9.-]", "", datos$CLAY_PCT))

arcilla <- na.omit(arcilla_raw)
arcilla <- arcilla[arcilla >= 0 & arcilla <= 100]

# Número de datos
n <- length(arcilla)

# CARGA DE 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(knitr)
library(e1071)
library(moments)

## 
## Adjuntando el paquete: 'moments'

## The following objects are masked from 'package:e1071':
## 
##     kurtosis, moment, skewness

---

TABLA DE DISTRIBUCIÓN DE FRECUENCIA

Agrupación por la regla de Sturges

# Número de clases (Sturges)
k <- floor(1 + 3.3 * log10(n))

# mínimo y máximo
minimo <- min(arcilla)
maximo <- max(arcilla)

# rango
R <- maximo - minimo

# amplitud
A <- R / k

# Límites
Li <- round(seq(minimo, maximo - A + 1e-6, by = A),2)
Ls <- round(Li + A,2)

Ls[length(Ls)] <- maximo

# Marca de clase
MC <- round((Li + Ls)/2,2)

---

# FRECUENCIAS
# FRECUENCIAS
ni <- numeric(length(Li))

for(i in 1:length(Li)){
  
  if(i == length(Li)){
    ni[i] <- sum(arcilla >= Li[i] & arcilla <= Ls[i])
  } else {
    ni[i] <- sum(arcilla >= Li[i] & arcilla < Ls[i])
  }
}

# Frecuencia relativa
hi <- round((ni/sum(ni))*100,2)

# Frecuencias acumuladas
Niasc <- cumsum(ni)
Nidsc <- rev(cumsum(rev(ni)))

Hiasc <- round(cumsum(hi),2)
Hidsc <- round(rev(cumsum(rev(hi))),2)

---

# TABLA DE DISTRIBUCIÓN
TDArcilla <- round(data.frame(
  Li, Ls, MC, ni, hi, Niasc, Nidsc, Hiasc, Hidsc
),2)

TDArcilla

##       Li    Ls    MC    ni    hi Niasc Nidsc  Hiasc  Hidsc
## 1   0.00  6.31  3.15 14156 51.98 14156 27233  51.98 100.00
## 2   6.31 12.62  9.46  2706  9.94 16862 13077  61.92  48.02
## 3  12.63 18.94 15.79  2536  9.31 19398 10371  71.23  38.08
## 4  18.94 25.25 22.09  1725  6.33 21123  7835  77.56  28.77
## 5  25.26 31.57 28.41  1437  5.28 22560  6110  82.84  22.44
## 6  31.57 37.88 34.73  1325  4.87 23885  4673  87.71  17.16
## 7  37.88 44.19 41.03  1037  3.81 24922  3348  91.52  12.29
## 8  44.20 50.51 47.36   680  2.50 25602  2311  94.02   8.48
## 9  50.51 56.82 53.66   457  1.68 26059  1631  95.70   5.98
## 10 56.83 63.14 59.98   371  1.36 26430  1174  97.06   4.30
## 11 63.14 69.45 66.30   298  1.09 26728   803  98.15   2.94
## 12 69.45 75.76 72.61   250  0.92 26978   505  99.07   1.85
## 13 75.77 82.08 78.92   162  0.59 27140   255  99.66   0.93
## 14 82.08 88.39 85.24    74  0.27 27214    93  99.93   0.34
## 15 88.40 94.71 91.56    19  0.07 27233    19 100.00   0.07

---

# Fila total 
fila_total <- data.frame(
  Li = "TOTAL",
  Ls = "",
  MC = "",
  ni = sum(TDArcilla$ni),
  hi = round(sum(TDArcilla$hi)),
  Niasc = "",
  Nidsc = "",
  Hiasc = "",
  Hidsc = ""
)

TDArcilla_p <- rbind(TDArcilla, fila_total)

---

# TABLA DE DISTRIBUCIÓN FINAL
TablaArcilla <- TDArcilla_p %>%
  gt() %>%
  tab_header(
    title = md("**Tabla Nº1**"),
    subtitle = md("Tabla de distribución de cantidad de Arcilla (%) en sedimentos marinos")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 3")
  ) %>%
  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"
  )

TablaArcilla

Tabla Nº1
Tabla de distribución de cantidad de Arcilla (%) en sedimentos marinos
Li	Ls	MC	ni	hi	Niasc	Nidsc	Hiasc	Hidsc
0	6.31	3.15	14156	51.98	14156	27233	51.98	100
6.31	12.62	9.46	2706	9.94	16862	13077	61.92	48.02
12.63	18.94	15.79	2536	9.31	19398	10371	71.23	38.08
18.94	25.25	22.09	1725	6.33	21123	7835	77.56	28.77
25.26	31.57	28.41	1437	5.28	22560	6110	82.84	22.44
31.57	37.88	34.73	1325	4.87	23885	4673	87.71	17.16
37.88	44.19	41.03	1037	3.81	24922	3348	91.52	12.29
44.2	50.51	47.36	680	2.50	25602	2311	94.02	8.48
50.51	56.82	53.66	457	1.68	26059	1631	95.7	5.98
56.83	63.14	59.98	371	1.36	26430	1174	97.06	4.3
63.14	69.45	66.3	298	1.09	26728	803	98.15	2.94
69.45	75.76	72.61	250	0.92	26978	505	99.07	1.85
75.77	82.08	78.92	162	0.59	27140	255	99.66	0.93
82.08	88.39	85.24	74	0.27	27214	93	99.93	0.34
88.4	94.71	91.56	19	0.07	27233	19	100	0.07
TOTAL			27233	100.00
Autor: Grupo 3

---

GRÁFICAS DE DISTRIBUCIÓN DE FRECUENCIA

## Histograma de frecuencia absoluta local
hist(arcilla,
     breaks = k,
     main = "Gráfica Nº1: Distribución de cantidad de Arcilla
     en Sedimentos Marinos (Local)",
     xlab = "Arcilla (%)",
     ylab = "Cantidad",
     col = "gray")

---

# Histograma de frecuencia absoluta global
hist(arcilla,
     breaks = k,
     main = "Gráfica Nº2: Distribución de cantidad de Arcilla
     en Sedimentos Marinos (Global)",
     xlab = "Arcilla (%)",
     ylab = "Cantidad",
     col = "gray",
     ylim = c(0,max(ni)+10))

---

# Frecuencia relativa local
barplot(hi,
        space = 0,
        main = "Gráfica Nº3: Distribución de cantidad en porcentaje de Arcilla
        en Sedimentos Marinos (Local)",
        col = "gray",
        xlab = "Intervalos de Arcilla (%)",
        ylab = "Porcentaje",
        names.arg = MC)

---

# Frecuencia relativa global
barplot(hi,
        space = 0,
        main = "Gráfica Nº4: Distribución de cantidad en porcentaje de Arcilla
        en Sedimentos Marinos (Global)",
        col = "gray",
        xlab = "Intervalos de Arcilla (%)",
        ylab = "Porcentaje",
        names.arg = MC,
        ylim = c(0,100))

---

# Ojiva combinada Ni
plot(Ls, Nidsc, type="o",
     main="Gráfica Nº5: Ojiva combinada de Arcilla (Ni)",
     ylab="Cantidad acumulada",
     col="blue",
     xlab="Arcilla (%)")

lines(Li, Niasc, col="red", type="o")

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

---

# Ojiva combinada Hi
plot(Ls, Hidsc, type="o",
     main="Gráfica Nº6: Ojiva combinada de Arcilla (Hi)",
     ylab="Porcentaje acumulado",
     col="blue",
     xlab="Arcilla (%)",
     ylim=c(0,100))

lines(Li, Hiasc, col="red", type="o")

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

---

# Diagrama de caja
boxplot(arcilla,
        horizontal = TRUE,
        main = "Gráfica Nº7: Distribución de Arcilla en Sedimentos Marinos",
        xlab = "Arcilla (%)",
        col = "lightblue")

---

INDICADORES ESTADÍSTICOS

# Cálculo de indicadores
media <- mean(arcilla)
mediana <- median(arcilla)
desv <- sd(arcilla)

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

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

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

TablaIndicadores <- data.frame(
  Variable = "Arcilla (%)",
  Minimo = round(minimo,2),
  Maximo = round(maximo,2),
  Media = round(media,2),
  Mediana = round(mediana,2),
  Desv_Est = round(desv,2),
  CV = CV,
  Asimetria = asimetria,
  Curtosis = curtosis
)

TablaIndicadores

##      Variable Minimo Maximo Media Mediana Desv_Est     CV Asimetria Curtosis
## 1 Arcilla (%)      0  94.71 14.21    5.37    18.39 129.46      1.55     4.89

---

# Tabla Mejorada
TablaIndicadores %>%
  gt() %>%
  tab_header(
    title = md("**Tabla Nº2**"),
    subtitle = md("Indicadores estadísticos de la variable Arcilla (%)")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 3")
  )

Tabla Nº2
Indicadores estadísticos de la variable Arcilla (%)
Variable	Minimo	Maximo	Media	Mediana	Desv_Est	CV	Asimetria	Curtosis
Arcilla (%)	0	94.71	14.21	5.37	18.39	129.46	1.55	4.89
Autor: Grupo 3

---

OUTLIERS

# OUTLIERS
outliers <- boxplot.stats(arcilla)$out

num_outliers <- length(outliers)

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

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

TablaOutliers

##   Cantidad_Outliers Minimo Maximo
## 1              1275  55.43  94.71

---

#Tabla Mejorada 
TablaOutliers %>%
  gt() %>%
  tab_header(
    title = md("**Tabla Nº3**"),
    subtitle = md("Valores atípicos de la variable Arcilla (%)")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 3")
  )

Tabla Nº3
Valores atípicos de la variable Arcilla (%)
Cantidad_Outliers	Minimo	Maximo
1275	55.43	94.71
Autor: Grupo 3

---

CONCLUSIÓN

La variable Arcilla (%) presenta valores que fluctúan entre 0 y 94.71 %, con valores entorno a 5.37 %, y una desviación estándar de 18.39 %, lo que indica un conjunto altamente heterogéneo. La acumulación de datos se concentra de manera marcada en los valores bajos, lo cual también se evidencia por la asimetría positiva (1.55) que indica una distribución sesgada hacia la derecha. Con la existencia de valores atípicos en los rangos superiores de la distribución. Por lo anterior, el comportamiento es medianamente beneficioso, ya que la mayoría de los sedimentos presentan bajos contenidos de arcilla, mientras que solo algunos registros alcanzan concentraciones elevadas.