Análisis Estadístico Arcilla

1. CARGA DE LIBRERÍAS Y DATOS

# CARGA DE LIBRERÍAS
library(gt)
library(dplyr)
library(knitr)
library(e1071)
library(moments)

# CARGA DE DATOS
datos <- read.csv("C:/Users/Grace/Downloads/dataset_geologico_limpio_80.csv",
                  header = TRUE,
                  sep = ",",
                  dec = ".",
                  stringsAsFactors = FALSE)

2. SELECCIÓN DE LA VARIABLE

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

La variable CLAY_PCT representa el porcentaje de arcilla presente en cada muestra de sedimento marino. Es una variable cuantitativa continua, porque puede tomar cualquier valor decimal dentro de un intervalo. Para el análisis se eliminan los valores faltantes y se conservan únicamente los porcentajes comprendidos entre 0 y 100.

3. TABLA DE DISTRIBUCIÓN DE FRECUENCIA

TABLA DE DISTRIBUCIÓN DE CANTIDAD POR STURGES

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

k_sturges <- round(1 + 3.322 * log10(n))

# Según recomendación de la asignatura se utilizan
# máximo 10 clases para facilitar la interpretación gráfica
k <- min(k_sturges, 10)

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

# Rango y amplitud
R <- maximo - minimo
A <- R / k

# Límites Inferiores y Superiores
# Los limites exactos se usan para contar; los redondeados solo para mostrar.
cortes <- seq(from = minimo, to = maximo, length.out = k + 1)
Li_calc <- cortes[-length(cortes)]
Ls_calc <- cortes[-1]

Li <- round(Li_calc, 2)
Ls <- round(Ls_calc, 2)

# Marca de clase
MC <- round((Li_calc + Ls_calc)/2, 2)

# Frecuencia absoluta
ni <- numeric(length(Li_calc))
for(i in 1:length(Li_calc)){
  if(i == length(Li_calc)){
    ni[i] <- sum(arcilla >= Li_calc[i] & arcilla <= Ls_calc[i])
  } else {
    ni[i] <- sum(arcilla >= Li_calc[i] & arcilla < Ls_calc[i])
  }
}

if(sum(ni) != n){
  stop("La suma de frecuencias no coincide con el tamaño muestral.")
}

# Frecuencia relativa
# Se calcula sin redondear para evitar que los acumulados superen 100 %
hi_calc <- (ni / n) * 100
hi <- round(hi_calc, 2)

# Frecuencias acumuladas
Niasc <- cumsum(ni)
Nidsc <- rev(cumsum(rev(ni)))
Hiasc <- round(cumsum(hi_calc), 2)
Hidsc <- round(rev(cumsum(rev(hi_calc))), 2)

# Tabla Sturges
TDArcilla <- round(data.frame(
  Li, Ls, MC, ni, hi, Niasc, Nidsc, Hiasc, Hidsc
), 2)

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

TDArcilla_p <- rbind(TDArcilla, fila_total)

TABLA FINAL STURGES CON GT

TablaArcilla <- TDArcilla_p %>%
  gt() %>%
  tab_header(
    title = md("**Tabla Nº1**"),
    subtitle = md("Tabla de distribución de cantidad de Arcilla (%)<br>por regla de Sturges")
  ) %>%
  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 = Li == "TOTAL"))
TablaArcilla

Tabla Nº1
Tabla de distribución de cantidad de Arcilla (%) por regla de Sturges
Li	Ls	MC	ni	hi	Niasc	Nidsc	Hiasc	Hidsc
0	9.47	4.74	15644	57.43	15644	27240	57.43	100
9.47	18.94	14.21	3758	13.80	19402	11596	71.23	42.57
18.94	28.41	23.68	2446	8.98	21848	7838	80.21	28.77
28.41	37.88	33.15	2044	7.50	23892	5392	87.71	19.79
37.88	47.36	42.62	1374	5.04	25266	3348	92.75	12.29
47.36	56.83	52.09	800	2.94	26066	1974	95.69	7.25
56.83	66.3	61.56	528	1.94	26594	1174	97.63	4.31
66.3	75.77	71.03	391	1.44	26985	646	99.06	2.37
75.77	85.24	80.5	206	0.76	27191	255	99.82	0.94
85.24	94.71	89.97	49	0.18	27240	49	100	0.18
TOTAL			27240	100.00
Autor: Grupo 2

La regla de Sturges recomienda un número teórico de clases que genera límites con varios valores decimales. Aunque estos límites son estadísticamente válidos, dificultan la lectura y comparación de los intervalos. Por esta razón, se elaboró una tabla simplificada de 10 clases con límites más sencillos, facilitando la comprensión e interpretación de la distribución sin modificar la naturaleza continua de la variable.

TABLA DE DISTRIBUCIÓN AGRUPADA

# Histograma utilizando 10 clases
# (criterio adoptado para facilitar la interpretación)
histograma_arcilla <- hist(
  arcilla,
  breaks = k,
  plot = FALSE
)

# Límites Inferiores y Superiores
lis <- histograma_arcilla$breaks[1:(length(histograma_arcilla$breaks)-1)]
lss <- histograma_arcilla$breaks[2:length(histograma_arcilla$breaks)]

# Marca de clase
MC_f <- round(histograma_arcilla$mids, 2)

# Frecuencia absoluta
ni_f <- histograma_arcilla$counts

# Frecuencia relativa
hi_f <- round((ni_f / sum(ni_f)) * 100, 2)

# Frecuencias acumuladas
Niasc_f <- cumsum(ni_f)
Nidsc_f <- rev(cumsum(rev(ni_f)))
Hiasc_f <- round(cumsum(hi_f), 2)
Hidsc_f <- round(rev(cumsum(rev(hi_f))), 2)

# Tabla Simplificada
TDArcilla_f <- round(data.frame(
  Li = lis,
  Ls = lss,
  MC = MC_f,
  ni = ni_f,
  hi = hi_f,
  Niasc = Niasc_f,
  Nidsc = Nidsc_f,
  Hiasc = Hiasc_f,
  Hidsc = Hidsc_f
), 2)

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

TDArcilla_t <- rbind(TDArcilla_f, fila_total_f)

TABLA SIMPLIFICADA FINAL CON GT

TablaArcilla_simp <- TDArcilla_t %>%
  gt() %>%
  tab_header(
    title = md("**Tabla Nº2**"),
    subtitle = md("Tabla de distribución simplificada de Arcilla (%)<br>obtenida mediante el histograma")
  ) %>%
  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 = Li == "TOTAL")
  )
TablaArcilla_simp

Tabla Nº2
Tabla de distribución simplificada de Arcilla (%) obtenida mediante el histograma
Li	Ls	MC	ni	hi	Niasc	Nidsc	Hiasc	Hidsc
0	10	5	15876	58.28	15876	27240	58.28	100
10	20	15	3849	14.13	19725	11364	72.41	41.72
20	30	25	2475	9.09	22200	7515	81.5	27.59
30	40	35	2072	7.61	24272	5040	89.11	18.5
40	50	45	1285	4.72	25557	2968	93.83	10.89
50	60	55	725	2.66	26282	1683	96.49	6.17
60	70	65	474	1.74	26756	958	98.23	3.51
70	80	75	341	1.25	27097	484	99.48	1.77
80	90	85	134	0.49	27231	143	99.97	0.52
90	100	95	9	0.03	27240	9	100	0.03
TOTAL			27240	100.00
Autor: Grupo 2

4. GRÁFICAS DE DISTRIBUCIÓN DE FRECUENCIA

# Histograma de frecuencia absoluta local
# Representa la cantidad observada en cada intervalo

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

# Histograma de frecuencia absoluta global
# Escalado respecto al tamaño total de la muestra

hist(arcilla,
     breaks = k,
     main = "Gráfica Nº2: Distribución de cantidad de Arcilla
     en Sedimentos Marinos",
     xlab = "Arcilla (%)",
     ylab = "Cantidad",
     col = "lightgray",
     border = "black",
     ylim = c(0, n * 1.05))

# Histograma de frecuencia relativa local
# Muestra el porcentaje observado en cada intervalo

barplot(hi_f,
        space = 0,
        names.arg = lss,
        main = "Gráfica Nº3: Distribución de cantidad en porcentaje de Arcilla
        en Sedimentos Marinos",
        col = "gray",
        xlab = "Arcilla (%) - Límite Superior",
        ylab = "Porcentaje",
        ylim = c(0, max(hi_f)*1.1),
        las = 2,
        cex.names = 0.75)

# Histograma de frecuencia relativa global
# Escala porcentual completa de 0 a 100 %

barplot(hi_f,
        space = 0,
        names.arg = lss,
        main = "Gráfica Nº4: Distribución de cantidad en porcentaje de Arcilla
        en Sedimentos Marinos",
        col = "gray",
        xlab = "Arcilla (%) - Límite Superior",
        ylab = "Porcentaje",
        ylim = c(0,100),
        las = 2,
        cex.names = 0.75)

# Ojiva combinada Ni
par(mar = c(8, 4, 4, 2) + 0.1)

# Añadir los extremos para que ambas ojivas comiencen y terminen completas
x_desc <- c(lis, lss[length(lss)])
y_desc_Ni <- c(Nidsc_f, 0)
x_asc <- c(lis[1], lss)
y_asc_Ni <- c(0, Niasc_f)

plot(x_desc, y_desc_Ni, type="o", pch=19, cex=1.2,
     main="Gráfica Nº5: Ojiva combinada de Arcilla (Ni)",
     ylab="Cantidad acumulada",
     col="blue",
     xlab="",
     xaxt="n",
     xlim=c(0, max(lss)),
     ylim=c(0, n),
     lwd=2)

lines(x_asc, y_asc_Ni, type="o", pch=19, cex=1.2, col="red", lwd=2)

marcas_x <- unique(c(0, round(lss, 2)))
axis(1, at=marcas_x, labels=FALSE)
text(
  marcas_x,
  par("usr")[3] - 0.035 * diff(par("usr")[3:4]),
  labels=marcas_x,
  srt=45,
  adj=1,
  xpd=TRUE,
  cex=0.75
)
mtext("Arcilla (%)", side=1, line=5.8)

legend("bottom",
       legend=c("Descendente","Ascendente"),
       col=c("blue","red"),
       pch=c(19,19),
       lwd=c(2,2),
       horiz=TRUE,
       inset=0.02,
       bty="n")

par(mar = c(5, 4, 4, 2) + 0.1)

# Ojiva combinada Hi
par(mar = c(8, 4, 4, 2) + 0.1)

y_desc_Hi <- c(Hidsc_f, 0)
y_asc_Hi <- c(0, Hiasc_f)

plot(x_desc, y_desc_Hi, type="o", pch=19, cex=1.2,
     main="Gráfica Nº6: Ojiva combinada de Arcilla (Hi)",
     ylab="Porcentaje acumulado",
     col="blue",
     xlab="",
     xaxt="n",
     xlim=c(0, max(lss)),
     ylim=c(0,100),
     lwd=2)

lines(x_asc, y_asc_Hi, type="o", pch=19, cex=1.2, col="red", lwd=2)

marcas_x <- unique(c(0, round(lss, 2)))
axis(1, at=marcas_x, labels=FALSE)
text(
  marcas_x,
  par("usr")[3] - 0.035 * diff(par("usr")[3:4]),
  labels=marcas_x,
  srt=45,
  adj=1,
  xpd=TRUE,
  cex=0.75
)
mtext("Arcilla (%)", side=1, line=5.8)

legend("bottom",
       legend=c("Descendente","Ascendente"),
       col=c("blue","red"),
       pch=c(19,19),
       lwd=c(2,2),
       horiz=TRUE,
       inset=0.02,
       bty="n")

par(mar = c(5, 4, 4, 2) + 0.1)

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

# Justificación:
# Se emplea frecuencia relativa local (Hi) para representar
# la distribución porcentual de los datos y facilitar la
# comparación entre intervalos.
# Histograma con Hi (Frecuencia Relativa Local)

h_rel <- hist(
  arcilla,
  breaks = k,
  plot = FALSE
)

hist(
  arcilla,
  breaks = k,
  probability = TRUE,
  freq = FALSE,
  main = "Gráfica N°8: Histograma y Diagrama de Caja Superpuesto - Arcilla (%)",
  xlab = "Arcilla (%)",
  ylab = "Hi (%)",
  col = "lightgray",
  border = "black"
)

# Superposición del boxplot

boxplot(
  arcilla,
  horizontal = TRUE,
  add = TRUE,
  axes = FALSE,

  # Altura donde se dibuja
  at = max(h_rel$density)*0.85,

  # Grosor de la caja
  boxwex = max(h_rel$density)*0.15,

  col = rgb(0,0.65,1,0.55),
  border = "darkblue",
  lwd = 2
)

 #Justificacion:
# Para la representacion conjunta del histograma y poligono
# se emplea la frecuencia relativa local en porcentaje (Hi).
# Las barras y el poligono usan los mismos intervalos de la
# tabla agrupada, por eso la lectura coincide con hi_f.

plot(NA,
     xlim = range(c(lis, lss)),
     ylim = c(0, max(hi_f) * 1.15),
     main = "Grafica N 9: Histograma y Poligono de Frecuencia Relativa de Arcilla (%)",
     xlab = "Arcilla (%)",
     ylab = "Frecuencia relativa (%)")

# Histograma en porcentaje
rect(xleft = lis,
     ybottom = 0,
     xright = lss,
     ytop = hi_f,
     col = "lightgray",
     border = "black")

# Poligono cerrado con marcas de clase
x_poly <- c(lis[1], MC_f, lss[length(lss)])
y_poly <- c(0, hi_f, 0)

lines(x_poly,
      y_poly,
      type = "o",
      col = "blue",
      lwd = 2,
      pch = 16)

legend("topright",
       legend = "Poligono de Frecuencia Relativa (%)",
       col = "blue",
       lwd = 2,
       pch = 16,
       bty = "n")

5. INDICADORES ESTADÍSTICOS

# Cálculo de indicadores estadísticos

# Media aritmética (x̄)
media <- mean(arcilla)

# Mediana (Me)
mediana <- median(arcilla)

# Desviación estándar muestral (s)
desv <- sd(arcilla)

# Coeficiente de variación (CV)
CV <- round((desv/media)*100,2)

# Coeficiente de asimetría (As)
asimetria <- round(skewness(arcilla),2)

# Coeficiente de curtosis (K)
curtosis <- round(kurtosis(arcilla),2)

# Valor mínimo (Min)
minimo <- min(arcilla)

# Valor máximo (Max)
maximo <- max(arcilla)

# Tabla de indicadores estadísticos
TablaIndicadores <- data.frame(
  Variable = "Arcilla (%)",
  Min = round(minimo,2),      # Mínimo
  Max = round(maximo,2),      # Máximo
  Media = round(media,2),     # x̄
  Me = round(mediana,2),      # Mediana
  s = round(desv,2),          # Desviación estándar
  CV = CV,                    # Coeficiente de variación
  As = asimetria,             # Asimetría
  K = curtosis                # Curtosis
)

TablaIndicadores

##      Variable Min   Max Media   Me     s     CV   As    K
## 1 Arcilla (%)   0 94.71 14.21 5.37 18.39 129.46 1.55 4.89

# Tabla mejorada de indicadores estadísticos
TablaIndicadores %>%
  gt() %>%
  cols_label(
    Min = "Min",
    Max = "Max",
    Media = "x̄",
    Me = "Me",
    s = "s",
    CV = "Cv",
    As = "As",
    K = "K"
  ) %>%
  tab_header(
    title = md("**Tabla Nº3**"),
    subtitle = md("Indicadores estadísticos de la variable Arcilla (%)")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 2")
  )

Tabla Nº3
Indicadores estadísticos de la variable Arcilla (%)
Variable	Min	Max	x̄	Me	s	Cv	As	K
Arcilla (%)	0	94.71	14.21	5.37	18.39	129.46	1.55	4.89
Autor: Grupo 2

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º4**"),
    subtitle = md("Valores atípicos de la variable Arcilla (%)")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 2")
  )

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

6. CONCLUSIÓN

Los valores de la variable Arcilla (%) fluctúan entre 0 y 94.71 % y giran en torno a una mediana de 5.37 %, con una desviación estándar de 18.39 %. Se identificaron 1275 valores atípicos, comprendidos entre 55.43 % y 94.71 %. Debido a su coeficiente de variación de 129.46 %, constituye un conjunto de datos heterogéneo, cuyos valores se agrupan fuertemente en la parte baja de la variable, de acuerdo con su asimetría positiva de 1.55. Por lo anterior, su comportamiento es beneficioso porque predominan los contenidos bajos de arcilla, aunque la elevada variabilidad y los valores atípicos reducen la uniformidad de las muestras.