Carga de datos y librerías Extraer la variable Conclusión

1. CARGA DE DATOS Y LIBRERÍAS

library(readxl)
library(gt)
library(e1071)

datos <- read_excel(
  "dataset_deslizamientos_dia_hora.xlsx",
  sheet = 1
)

2. EXTRAER LA VARIABLE

DIA <- as.numeric(
  datos$DIA
)

DIA <- DIA[
  !is.na(DIA) &
  DIA >= 1 &
  DIA <= 31 &
  DIA %% 1 == 0
]

DIA <- as.integer(
  DIA
)

N_total <- length(
  DIA
)

3. CONTEO

Debido a que la variable DIA presenta 31 valores posibles y una cantidad elevada de registros, se aplica la regla de Sturges para resumir su distribución mediante intervalos.

El valor cero no se incluye porque no representa un día válido del mes.

3.1. Parámetros de clasificación

xmin <- min(DIA)
xmax <- max(DIA)

limite_inicial <- xmin - 0.5
limite_final <- xmax + 0.5

rango_real <- limite_final - limite_inicial

k <- ceiling(
  1 + 3.322 * log10(N_total)
)

amplitud <- rango_real / k

parametros <- data.frame(
  Observaciones = N_total,
  Minimo = xmin,
  Maximo = xmax,
  Rango = rango_real,
  Clases_Sturges = k,
  Amplitud = round(amplitud, 4)
)

parametros
##   Observaciones Minimo Maximo Rango Clases_Sturges Amplitud
## 1         11033      1     31    31             15   2.0667

3.2. Definición de clases

limites_clase <- seq(
  from = limite_inicial,
  to = limite_final,
  length.out = k + 1
)

Li <- head(
  limites_clase,
  -1
)

Ls <- tail(
  limites_clase,
  -1
)

MC <- (
  Li + Ls
) / 2

clases_etiquetas <- paste0(
  "[",
  round(Li, 2),
  " ; ",
  round(Ls, 2),
  ")"
)

3.3. Cálculo de frecuencias

clase_dia <- cut(
  DIA,
  breaks = limites_clase,
  include.lowest = TRUE,
  right = FALSE
)

ni <- as.numeric(
  table(clase_dia)
)

hi <- ni / N_total

Hi_asc <- cumsum(
  hi
) * 100

Hi_dsc <- rev(
  cumsum(
    rev(hi)
  )
) * 100

4. TABLA DE FRECUENCIAS

4.1. Tabla individual

dias_completos <- 1:31

conteo_dias <- table(
  factor(
    DIA,
    levels = dias_completos
  )
)

tabla_individual <- data.frame(
  Dia = as.character(
    dias_completos
  ),
  ni = as.numeric(
    conteo_dias
  ),
  hi = as.numeric(
    conteo_dias
  ) / N_total
)

tabla_individual <- rbind(
  tabla_individual,
  data.frame(
    Dia = "TOTAL",
    ni = sum(
      tabla_individual$ni
    ),
    hi = sum(
      tabla_individual$hi
    )
  )
)

tabla_individual |>

  tabla_blanca(
    titulo = "Tabla Nro. 1",
    subtitulo = "Conteo individual de los días de ocurrencia"
  ) |>

  fmt_number(
    columns = hi,
    decimals = 4
  ) |>

  cols_label(
    Dia = "Día del mes",
    ni = "ni",
    hi = "hi"
  ) |>

  cols_width(
    Dia ~ px(430),
    ni ~ px(220),
    hi ~ px(220)
  ) |>

  tab_style(
    style = cell_text(
      weight = "bold"
    ),
    locations = cells_body(
      rows = Dia == "TOTAL"
    )
  )
Tabla Nro. 1
Conteo individual de los días de ocurrencia
Día del mes ni hi
1 341 0.0309
2 296 0.0268
3 346 0.0314
4 342 0.0310
5 347 0.0315
6 491 0.0445
7 399 0.0362
8 358 0.0324
9 361 0.0327
10 358 0.0324
11 353 0.0320
12 393 0.0356
13 313 0.0284
14 335 0.0304
15 392 0.0355
16 450 0.0408
17 388 0.0352
18 433 0.0392
19 433 0.0392
20 409 0.0371
21 369 0.0334
22 372 0.0337
23 302 0.0274
24 356 0.0323
25 324 0.0294
26 313 0.0284
27 358 0.0324
28 326 0.0295
29 306 0.0277
30 299 0.0271
31 170 0.0154
TOTAL 11033 1.0000
Elaborado por: Geología Grupo 1

4.2. Tabla agrupada

tabla_agrupada <- data.frame(
  Intervalo = clases_etiquetas,
  ni = ni,
  hi = hi
)

tabla_agrupada <- rbind(
  tabla_agrupada,
  data.frame(
    Intervalo = "TOTAL",
    ni = sum(ni),
    hi = sum(hi)
  )
)

tabla_agrupada |>

  tabla_blanca(
    titulo = "Tabla Nro. 2",
    subtitulo = "Distribución agrupada de los días mediante Sturges"
  ) |>

  fmt_number(
    columns = hi,
    decimals = 4
  ) |>

  cols_label(
    Intervalo = "Intervalo",
    ni = "ni",
    hi = "hi"
  ) |>

  cols_width(
    Intervalo ~ px(430),
    ni ~ px(220),
    hi ~ px(220)
  ) |>

  tab_style(
    style = cell_text(
      weight = "bold"
    ),
    locations = cells_body(
      rows = Intervalo == "TOTAL"
    )
  )
Tabla Nro. 2
Distribución agrupada de los días mediante Sturges
Intervalo ni hi
[0.5 ; 2.57) 637 0.0577
[2.57 ; 4.63) 688 0.0624
[4.63 ; 6.7) 838 0.0760
[6.7 ; 8.77) 757 0.0686
[8.77 ; 10.83) 719 0.0652
[10.83 ; 12.9) 746 0.0676
[12.9 ; 14.97) 648 0.0587
[14.97 ; 17.03) 1230 0.1115
[17.03 ; 19.1) 866 0.0785
[19.1 ; 21.17) 778 0.0705
[21.17 ; 23.23) 674 0.0611
[23.23 ; 25.3) 680 0.0616
[25.3 ; 27.37) 671 0.0608
[27.37 ; 29.43) 632 0.0573
[29.43 ; 31.5) 469 0.0425
TOTAL 11033 1.0000
Elaborado por: Geología Grupo 1

5. GRÁFICAS

5.1. Cantidad de deslizamientos por día

tabla_individual_sin_total <- tabla_individual[
  tabla_individual$Dia != "TOTAL",
]

grafica_barras(
  valores = tabla_individual_sin_total$ni,
  etiquetas = tabla_individual_sin_total$Dia,
  titulo = paste0(
    "Gráfica Nro. 1: Cantidad de deslizamientos\n",
    "según el día del mes"
  ),
  eje_x = "Día de ocurrencia",
  eje_y = "Cantidad",
  color = "#E9D8C2",
  espacio = 0.20,
  rotacion = 1,
  tamano = 0.72
)

5.2. Porcentaje de deslizamientos por día

porcentaje_individual <- (
  tabla_individual_sin_total$hi *
  100
)

grafica_barras(
  valores = porcentaje_individual,
  etiquetas = tabla_individual_sin_total$Dia,
  titulo = paste0(
    "Gráfica Nro. 2: Porcentaje de deslizamientos\n",
    "según el día del mes"
  ),
  eje_x = "Día de ocurrencia",
  eje_y = "Porcentaje",
  color = "#CFA6B8",
  espacio = 0.20,
  rotacion = 1,
  tamano = 0.72
)

5.3. Diagrama de barras agrupadas

grafica_barras(
  valores = ni,
  etiquetas = clases_etiquetas,
  titulo = paste0(
    "Gráfica Nro. 3: Cantidad agrupada de deslizamientos\n",
    "según los intervalos obtenidos mediante Sturges"
  ),
  eje_x = "Intervalos del día de ocurrencia",
  eje_y = "Cantidad",
  color = "#E9D8C2",
  espacio = 0.25,
  rotacion = 2,
  tamano = 0.62
)

5.4. Diagrama de caja

par(
  mar = c(
    5,
    5,
    5,
    2
  )
)

boxplot(
  DIA,
  horizontal = TRUE,
  col = "#A7D3E8",
  border = "#222222",
  outline = TRUE,
  outpch = 1,
  outcol = "red",
  main = paste0(
    "Gráfica Nro. 4: Diagrama de caja y bigotes\n",
    "del día de ocurrencia"
  ),
  xlab = "Día de ocurrencia"
)

5.5. Ojivas ascendente y descendente

puntos_ojiva <- seq_len(
  k
)

par(
  mar = c(
    8,
    5,
    5,
    10
  )
)

plot(
  puntos_ojiva,
  Hi_asc,
  type = "b",
  pch = 17,
  col = "#F39C12",
  xaxt = "n",
  xlab = "",
  ylab = "Porcentaje",
  ylim = c(
    0,
    100
  ),
  main = paste0(
    "Gráfica Nro. 5: Distribución acumulada porcentual\n",
    "mediante ojivas ascendente y descendente"
  )
)

grid(
  col = "gray85"
)

lines(
  puntos_ojiva,
  Hi_dsc,
  type = "b",
  pch = 16,
  col = "#1F45FC"
)

axis(
  side = 1,
  at = puntos_ojiva,
  labels = clases_etiquetas,
  las = 2,
  cex.axis = 0.65
)

mtext(
  "Intervalos del día de ocurrencia",
  side = 1,
  line = 6
)

legend(
  "topright",
  inset = c(
    -0.30,
    0
  ),
  xpd = TRUE,
  legend = c(
    "Ascendente (Menor que)",
    "Descendente (Mayor que)"
  ),
  col = c(
    "#F39C12",
    "#1F45FC"
  ),
  pch = c(
    17,
    16
  ),
  lty = 1,
  bty = "n"
)

5.6. Barras agrupadas con boxplot superpuesto

frecuencia_maxima <- max(
  ni
)

posicion_boxplot <- frecuencia_maxima *
  0.55

altura_boxplot <- frecuencia_maxima *
  0.18

estadisticas_boxplot <- boxplot.stats(
  DIA
)

bigote_inferior <- estadisticas_boxplot$stats[1]
primer_cuartil <- estadisticas_boxplot$stats[2]
mediana_boxplot <- estadisticas_boxplot$stats[3]
tercer_cuartil <- estadisticas_boxplot$stats[4]
bigote_superior <- estadisticas_boxplot$stats[5]
atipicos_boxplot <- estadisticas_boxplot$out

ancho_gap <- amplitud *
  0.08

par(
  mar = c(
    5,
    5,
    5,
    2
  )
)

plot(
  NA,
  xlim = c(
    limite_inicial,
    limite_final
  ),
  ylim = c(
    0,
    frecuencia_maxima * 1.25
  ),
  main = paste0(
    "Gráfica Nro. 6: Cantidad agrupada de deslizamientos\n",
    "con boxplot superpuesto"
  ),
  xlab = "Día de ocurrencia",
  ylab = "Cantidad",
  xaxt = "n"
)

axis(
  side = 1,
  at = MC,
  labels = round(
    MC,
    1
  )
)

for (
  i in seq_len(k)
) {
  rect(
    xleft = Li[i] + ancho_gap,
    ybottom = 0,
    xright = Ls[i] - ancho_gap,
    ytop = ni[i],
    col = "#E9D8C2",
    border = "#333333"
  )
}

text(
  MC,
  ni,
  labels = ni,
  pos = 3,
  cex = 0.75,
  font = 2
)

segments(
  bigote_inferior,
  posicion_boxplot,
  bigote_superior,
  posicion_boxplot,
  lty = 2,
  lwd = 1.5
)

segments(
  bigote_inferior,
  posicion_boxplot - altura_boxplot * 0.18,
  bigote_inferior,
  posicion_boxplot + altura_boxplot * 0.18,
  lwd = 1.5
)

segments(
  bigote_superior,
  posicion_boxplot - altura_boxplot * 0.18,
  bigote_superior,
  posicion_boxplot + altura_boxplot * 0.18,
  lwd = 1.5
)

rect(
  primer_cuartil,
  posicion_boxplot - altura_boxplot / 2,
  tercer_cuartil,
  posicion_boxplot + altura_boxplot / 2,
  col = "#A7D3E8",
  border = "#222222",
  lwd = 1.3
)

segments(
  mediana_boxplot,
  posicion_boxplot - altura_boxplot / 2,
  mediana_boxplot,
  posicion_boxplot + altura_boxplot / 2,
  lwd = 3
)

if (
  length(atipicos_boxplot) > 0
) {
  points(
    atipicos_boxplot,
    rep(
      posicion_boxplot,
      length(atipicos_boxplot)
    ),
    pch = 1,
    col = "red",
    cex = 1.1
  )
}

6. INDICADORES

6.1. Cálculo de indicadores

media_dia <- mean(
  DIA
)

mediana_dia <- median(
  DIA
)

frecuencias_moda <- table(
  DIA
)

modas_dia <- as.numeric(
  names(
    frecuencias_moda[
      frecuencias_moda ==
      max(frecuencias_moda)
    ]
  )
)

texto_moda <- paste(
  modas_dia,
  collapse = ", "
)

varianza_dia <- var(
  DIA
)

desviacion_dia <- sd(
  DIA
)

coeficiente_variacion <- (
  desviacion_dia /
  media_dia
) * 100

asimetria_dia <- e1071::skewness(
  DIA
)

curtosis_dia <- e1071::kurtosis(
  DIA
)

valores_atipicos <- boxplot.stats(
  DIA
)$out

cantidad_atipicos <- length(
  valores_atipicos
)

texto_atipicos <- if (
  cantidad_atipicos == 0
) {
  "No existen"
} else {
  paste0(
    cantidad_atipicos,
    " valores entre ",
    min(valores_atipicos),
    " y ",
    max(valores_atipicos)
  )
}

interpretacion_cv <- ifelse(
  coeficiente_variacion <= 30,
  "homogéneos",
  "heterogéneos"
)

interpretacion_asimetria <- ifelse(
  asimetria_dia > 0.10,
  "asimetría positiva hacia la derecha",
  ifelse(
    asimetria_dia < -0.10,
    "asimetría negativa hacia la izquierda",
    "distribución aproximadamente simétrica"
  )
)

interpretacion_curtosis <- ifelse(
  curtosis_dia > 0.10,
  "leptocúrtica",
  ifelse(
    curtosis_dia < -0.10,
    "platicúrtica",
    "mesocúrtica"
  )
)

clase_modal <- which.max(
  ni
)

intervalo_modal <- clases_etiquetas[
  clase_modal
]

centro_modal <- MC[
  clase_modal
]

parte_variable <- ifelse(
  centro_modal <= limite_inicial + rango_real / 3,
  "parte baja",
  ifelse(
    centro_modal <= limite_inicial + 2 * rango_real / 3,
    "parte media",
    "parte alta"
  )
)

6.2. Tabla de indicadores

tabla_indicadores <- data.frame(
  Medida = c(
    "Media",
    "Mediana",
    "Moda",
    "Rango",
    "Varianza",
    "Desviación estándar",
    "Coeficiente de variación (%)",
    "Asimetría",
    "Curtosis",
    "Valores atípicos"
  ),
  Valor = c(
    round(media_dia, 2),
    round(mediana_dia, 2),
    texto_moda,
    paste0(
      min(DIA),
      " - ",
      max(DIA)
    ),
    round(varianza_dia, 2),
    round(desviacion_dia, 2),
    round(coeficiente_variacion, 2),
    round(asimetria_dia, 2),
    round(curtosis_dia, 2),
    texto_atipicos
  )
)

tabla_indicadores |>

  tabla_blanca(
    titulo = "Tabla Nro. 3",
    subtitulo = "Indicadores estadísticos de la variable DIA"
  ) |>

  cols_label(
    Medida = "Medida",
    Valor = "Valor"
  ) |>

  cols_width(
    Medida ~ px(500),
    Valor ~ px(370)
  )
Tabla Nro. 3
Indicadores estadísticos de la variable DIA
Medida Valor
Media 15.53
Mediana 16
Moda 6
Rango 1 - 31
Varianza 73.03
Desviación estándar 8.55
Coeficiente de variación (%) 55.04
Asimetría 0.03
Curtosis -1.13
Valores atípicos No existen
Elaborado por: Geología Grupo 1

7. CONCLUSIÓN

La variable día de ocurrencia fluctúa entre 1 y 31 días, y sus valores giran alrededor de un promedio de 15.53 días, con una desviación estándar de 8.55 días. De acuerdo con el coeficiente de variación, los datos son heterogéneos. La mayor presencia de registros se encuentra en el intervalo [14.97 ; 17.03), ubicado en la parte media de la variable. La distribución presenta distribución aproximadamente simétrica y una forma platicúrtica, sin presencia de valores atípicos. Este comportamiento no se considera beneficioso ni perjudicial por sí mismo, pero permite identificar la concentración temporal de los deslizamientos dentro del mes.