library(readxl)
library(gt)
library(e1071)
datos <- read_excel(
"dataset_deslizamientos_dia_hora.xlsx",
sheet = 1
)
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
)
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.
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
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),
")"
)
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
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 | ||
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 | ||
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
)
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
)
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
)
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"
)
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"
)
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
)
}
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"
)
)
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 | |
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.