# ==========================================
# Carga de librerías
# ==========================================
library(dplyr)
library(readxl)
library(gt)
# ==========================================
# Carga de la base de datos
# ==========================================
datos <- read_excel("datos_deslizamientos.xlsx")
# ==========================================
# Visualización de la estructura de la base
# ==========================================
str(datos)
## tibble [11,033 × 31] (S3: tbl_df/tbl/data.frame)
## $ source_name : chr [1:11033] "AGU" "Oregonian" "CBS News" "Reuters" ...
## $ source_link : chr [1:11033] "https://blogs.agu.org/landslideblog/2008/10/14/the-lifan-landslide-from-natural-disaster-to-cover-up/" "http://www.oregonlive.com/news/index.ssf/2009/01/landslide_plows_through_lake_o.html" "https://www.cbsnews.com/news/dozens-missing-after-peru-landslides/" "https://in.reuters.com/article/idINIndia-41450420090731" ...
## $ event_id : num [1:11033] 684 956 973 1067 2603 ...
## $ event_date : POSIXct[1:11033], format: "2008-08-01" "2008-08-02" ...
## $ HORA : chr [1:11033] "00:00:00" "02:00:00" "00:00:00" "00:00:00" ...
## $ event_title : chr [1:11033] "Sigou Village, Loufan County, Shanxi Province" "Lake Oswego, Oregon" "San Ramon district, 195 miles northeast of the capital, Lima," "Dailekh district" ...
## $ event_description : chr [1:11033] "occurred early in morning, 11 villagers buried in 7 houses" "Hours of heavy rain are to blame for an overnight mudslide in Lake Oswego." "(CBS/AP) At least 10 people died and as many as 80 were still missing Wednesday in central Peru after torrentia"| __truncated__ "One person was killed in Dailekh district, police said." ...
## $ location_description : chr [1:11033] "Sigou Village, Loufan County, Shanxi Province" "Lake Oswego, Oregon" "San Ramon district, 195 miles northeast of the capital, Lima," "Dailekh district" ...
## $ location_accuracy : chr [1:11033] "unknown" "5km" "10km" "unknown" ...
## $ landslide_category : chr [1:11033] "landslide" "mudslide" "landslide" "landslide" ...
## $ landslide_trigger : chr [1:11033] "rain" "downpour" "downpour" "monsoon" ...
## $ landslide_size : chr [1:11033] "large" "small" "large" "medium" ...
## $ landslide_setting : chr [1:11033] "mine" "unknown" "unknown" "unknown" ...
## $ fatality_count : num [1:11033] 11 0 10 1 0 0 0 3 NA 2 ...
## $ injury_count : num [1:11033] NA NA NA NA NA NA NA NA NA NA ...
## $ storm_name : chr [1:11033] NA NA NA NA ...
## $ photo_link : chr [1:11033] NA NA NA NA ...
## $ notes : chr [1:11033] NA NA NA NA ...
## $ event_import_source : chr [1:11033] "glc" "glc" "glc" "glc" ...
## $ event_import_id : num [1:11033] 684 956 973 1067 2603 ...
## $ country_name : chr [1:11033] "China" "United States" "Peru" "Nepal" ...
## $ country_code : chr [1:11033] "CN" "US" "PE" "NP" ...
## $ admin_division_name : chr [1:11033] "Shaanxi" "Oregon" "Junín" "Mid Western" ...
## $ admin_division_population: num [1:11033] 0 36619 14708 20908 798634 ...
## $ gazeteer_closest_point : chr [1:11033] "Jingyang" "Lake Oswego" "San Ramón" "Dailekh" ...
## $ gazeteer_distance : num [1:11033] 41.021 0.603 0.855 0.754 2.022 ...
## $ submitted_date : POSIXct[1:11033], format: "2014-04-01 00:00:00" "2014-04-01 00:00:00" ...
## $ created_date : POSIXct[1:11033], format: "2017-11-20 15:17:00" "2017-11-20 15:17:00" ...
## $ last_edited_date : POSIXct[1:11033], format: "2018-02-15 15:51:00" "2018-02-15 15:51:00" ...
## $ longitude : num [1:11033] 107.5 -122.7 -75.4 81.7 123.9 ...
## $ latitude : num [1:11033] 32.6 45.4 -11.1 28.8 10.3 ...
# ==========================================
# Consolidación de categorías
# ==========================================
datos <- datos %>%
mutate(
landslide_category_consol = case_when(
landslide_category %in% c(
"debris_flow",
"earth_flow",
"lahar"
) ~ "Flujos de suelo y rocas",
landslide_category %in% c(
"creep",
"topple",
"translational_slide"
) ~ "Deformación lenta del terreno",
landslide_category %in% c(
"complex",
"other",
"unknown"
) ~ "Movimientos complejos o no definidos",
landslide_category %in% c(
"riverbank_collapse",
"snow_avalanche"
) ~ "Otros movimientos poco comunes",
landslide_category == "landslide" ~
"Deslizamiento de tierra",
landslide_category == "mudslide" ~
"Deslizamiento de lodo",
landslide_category == "rock_fall" ~
"Caída de rocas",
TRUE ~ landslide_category
)
)
# ==========================================
# Extracción de la variable consolidada
# ==========================================
variable <- datos$landslide_category_consol
head(variable)
## [1] "Deslizamiento de tierra" "Deslizamiento de lodo"
## [3] "Deslizamiento de tierra" "Deslizamiento de tierra"
## [5] "Deslizamiento de tierra" "Deslizamiento de tierra"
# ==========================================
# Tratamiento de valores faltantes
# ==========================================
# La base de datos contiene un registro cuya
# categoría de deslizamiento no fue reportada (NA).
#
# Este registro NO se elimina de la base original.
# Únicamente se omite de manera temporal para el
# análisis de esta variable cualitativa, ya que no
# puede ser clasificado en ninguna categoría.
# Número de valores faltantes
sum(is.na(variable))
## [1] 1
# Tamaño de la muestra original
length(variable)
## [1] 11033
# Muestra efectiva para el análisis
variable <- variable[!is.na(variable)]
# Tamaño de la muestra utilizada
length(variable)
## [1] 11032
# Verificación
sum(is.na(variable))
## [1] 0
## <a id="sec24"></a>2.4 Tamaño de la muestra
``` r
# ==========================================
# Tamaño de la muestra
# ==========================================
N <- length(variable)
N
## [1] 11032
sum(is.na(variable))
## [1] 0
cat("Muestra original:", nrow(datos), "\n")
## Muestra original: 11033
cat("Valores faltantes:", sum(is.na(datos$landslide_category_consol)), "\n")
## Valores faltantes: 1
cat("Muestra analizada:", length(variable))
## Muestra analizada: 11032
# ==========================================
# Definir el orden de las categorías
# ==========================================
orden_categorias <- c(
"Deslizamiento de tierra",
"Flujos de suelo y rocas",
"Deslizamiento de lodo",
"Caída de rocas",
"Deformación lenta del terreno",
"Movimientos complejos o no definidos",
"Otros movimientos poco comunes"
)
# ==========================================
# Convertir la variable en factor
# ==========================================
variable <- factor(
variable,
levels = orden_categorias
)
# Comprobar si aparecieron NA al convertir a factor
sum(is.na(variable))
## [1] 0
# Mostrar los niveles existentes
levels(variable)
## [1] "Deslizamiento de tierra"
## [2] "Flujos de suelo y rocas"
## [3] "Deslizamiento de lodo"
## [4] "Caída de rocas"
## [5] "Deformación lenta del terreno"
## [6] "Movimientos complejos o no definidos"
## [7] "Otros movimientos poco comunes"
# ==========================================
# Frecuencia absoluta
# ==========================================
ni <- table(variable)
ni
## variable
## Deslizamiento de tierra Flujos de suelo y rocas
## 7648 208
## Deslizamiento de lodo Caída de rocas
## 2100 671
## Deformación lenta del terreno Movimientos complejos o no definidos
## 15 338
## Otros movimientos poco comunes
## 52
sum(ni)
## [1] 11032
# ==========================================
# Probabilidad simple
# ==========================================
hi <- prop.table(ni)
# ==========================================
# Probabilidad porcentual
# ==========================================
P <- hi * 100
# ==========================================
# Construcción de la tabla
# ==========================================
tabla_probabilidad <- data.frame(
Categoria = names(ni),
ni = as.numeric(ni),
hi = as.numeric(hi),
P = as.numeric(P)
)
tabla_probabilidad
## Categoria ni hi P
## 1 Deslizamiento de tierra 7648 0.693255983 69.3255983
## 2 Flujos de suelo y rocas 208 0.018854242 1.8854242
## 3 Deslizamiento de lodo 2100 0.190355330 19.0355330
## 4 Caída de rocas 671 0.060823060 6.0823060
## 5 Deformación lenta del terreno 15 0.001359681 0.1359681
## 6 Movimientos complejos o no definidos 338 0.030638144 3.0638144
## 7 Otros movimientos poco comunes 52 0.004713561 0.4713561
# ==========================================
# Probabilidad acumulada
# ==========================================
tabla_probabilidad$Hi <- cumsum(tabla_probabilidad$hi)
# ==========================================
# Probabilidad acumulada (%)
# ==========================================
tabla_probabilidad$P_acumulada <-
tabla_probabilidad$Hi * 100
tabla_probabilidad
## Categoria ni hi P Hi
## 1 Deslizamiento de tierra 7648 0.693255983 69.3255983 0.6932560
## 2 Flujos de suelo y rocas 208 0.018854242 1.8854242 0.7121102
## 3 Deslizamiento de lodo 2100 0.190355330 19.0355330 0.9024656
## 4 Caída de rocas 671 0.060823060 6.0823060 0.9632886
## 5 Deformación lenta del terreno 15 0.001359681 0.1359681 0.9646483
## 6 Movimientos complejos o no definidos 338 0.030638144 3.0638144 0.9952864
## 7 Otros movimientos poco comunes 52 0.004713561 0.4713561 1.0000000
## P_acumulada
## 1 69.32560
## 2 71.21102
## 3 90.24656
## 4 96.32886
## 5 96.46483
## 6 99.52864
## 7 100.00000
# ==========================================
# Agregar fila TOTAL
# ==========================================
fila_total <- data.frame(
Categoria = "TOTAL",
ni = sum(tabla_probabilidad$ni),
hi = sum(tabla_probabilidad$hi),
P = sum(tabla_probabilidad$P),
Hi = max(tabla_probabilidad$Hi),
P_acumulada = max(tabla_probabilidad$P_acumulada)
)
# ==========================================
# Tabla completa
# ==========================================
tabla_probabilidad_total <- rbind(
tabla_probabilidad,
fila_total
)
tabla_probabilidad_total
## Categoria ni hi P Hi
## 1 Deslizamiento de tierra 7648 0.693255983 69.3255983 0.6932560
## 2 Flujos de suelo y rocas 208 0.018854242 1.8854242 0.7121102
## 3 Deslizamiento de lodo 2100 0.190355330 19.0355330 0.9024656
## 4 Caída de rocas 671 0.060823060 6.0823060 0.9632886
## 5 Deformación lenta del terreno 15 0.001359681 0.1359681 0.9646483
## 6 Movimientos complejos o no definidos 338 0.030638144 3.0638144 0.9952864
## 7 Otros movimientos poco comunes 52 0.004713561 0.4713561 1.0000000
## 8 TOTAL 11032 1.000000000 100.0000000 1.0000000
## P_acumulada
## 1 69.32560
## 2 71.21102
## 3 90.24656
## 4 96.32886
## 5 96.46483
## 6 99.52864
## 7 100.00000
## 8 100.00000
tabla_presentacion <- tabla_probabilidad_total %>%
gt() %>%
tab_header(
title = md("**Tabla N° 1**"),
subtitle = md("Distribución de probabilidad de las categorías de deslizamientos a nivel mundial")
) %>%
cols_label(
Categoria = "Categoría de deslizamiento",
ni = "Frecuencia absoluta (ni)",
hi = "Probabilidad",
P = "Probabilidad (%)",
Hi = "Probabilidad acumulada",
P_acumulada = "Probabilidad acumulada (%)"
) %>%
fmt_number(
columns = c(hi, Hi),
decimals = 4
) %>%
fmt_number(
columns = c(P, P_acumulada),
decimals = 2
) %>%
#==========================
# Encabezado color vino
#==========================
tab_style(
style = list(
cell_fill(color = "#6D213C"),
cell_text(
color = "white",
weight = "bold"
)
),
locations = cells_column_labels(everything())
) %>%
#==========================
# Título
#==========================
tab_style(
style = cell_text(
color = "#6D213C",
weight = "bold",
size = px(20)
),
locations = cells_title(groups = "title")
) %>%
#==========================
# Subtítulo
#==========================
tab_style(
style = cell_text(
color = "#6D213C",
size = px(14)
),
locations = cells_title(groups = "subtitle")
) %>%
#==========================
# Fila TOTAL
#==========================
tab_style(
style = list(
cell_fill(color = "#F5E9ED"),
cell_text(weight = "bold")
),
locations = cells_body(
rows = Categoria == "TOTAL"
)
) %>%
#==========================
# Bordes
#==========================
tab_options(
table.border.top.color = "#6D213C",
table.border.bottom.color = "#6D213C",
heading.border.bottom.color = "#6D213C",
column_labels.border.bottom.color = "#6D213C"
) %>%
#==========================
# Fuente
#==========================
tab_source_note(
source_note = md("Autor: Grupo 1 – Carrera de Geología")
)
tabla_presentacion
| Tabla N° 1 | |||||
| Distribución de probabilidad de las categorías de deslizamientos a nivel mundial | |||||
| Categoría de deslizamiento | Frecuencia absoluta (ni) | Probabilidad | Probabilidad (%) | Probabilidad acumulada | Probabilidad acumulada (%) |
|---|---|---|---|---|---|
| Deslizamiento de tierra | 7648 | 0.6933 | 69.33 | 0.6933 | 69.33 |
| Flujos de suelo y rocas | 208 | 0.0189 | 1.89 | 0.7121 | 71.21 |
| Deslizamiento de lodo | 2100 | 0.1904 | 19.04 | 0.9025 | 90.25 |
| Caída de rocas | 671 | 0.0608 | 6.08 | 0.9633 | 96.33 |
| Deformación lenta del terreno | 15 | 0.0014 | 0.14 | 0.9646 | 96.46 |
| Movimientos complejos o no definidos | 338 | 0.0306 | 3.06 | 0.9953 | 99.53 |
| Otros movimientos poco comunes | 52 | 0.0047 | 0.47 | 1.0000 | 100.00 |
| TOTAL | 11032 | 1.0000 | 100.00 | 1.0000 | 100.00 |
| Autor: Grupo 1 – Carrera de Geología | |||||
# ==========================================
# Tabla para las gráficas
# ==========================================
tabla_graficos <- tabla_probabilidad
par(mar = c(12, 5, 4, 2))
pos_x <- barplot(
tabla_graficos$P,
names.arg = tabla_graficos$Categoria,
col = "steelblue",
border = "black",
space = 0.20,
las = 2,
ylim = c(0, 100),
yaxt = "n",
main = "Gráfica 1: Distribución de probabilidad de\nlas categorías de deslizamientos",
xlab = "",
ylab = "Probabilidad (%)",
cex.names = 0.75
)
ticks_y <- seq(0,100,20)
axis(
side = 2,
at = ticks_y,
labels = ticks_y,
las = 1
)
text(
x = pos_x,
y = tabla_graficos$P,
labels = round(tabla_graficos$P,2),
pos = 3,
font = 2,
cex = 0.80
)
par(mar = c(12, 5, 4, 2))
pos_x <- barplot(
tabla_graficos$P_acumulada,
names.arg = tabla_graficos$Categoria,
col = "skyblue",
border = "black",
space = 0.20,
las = 2,
ylim = c(0,100),
yaxt = "n",
main = "Gráfica 2: Distribución de probabilidad acumulada\n de las categorías de deslizamientos",
xlab = "",
ylab = "Probabilidad acumulada (%)",
cex.names = 0.75
)
ticks_y <- seq(0,100,20)
axis(
side = 2,
at = ticks_y,
labels = ticks_y,
las = 1
)
abline(
h = 100,
col = "red",
lty = 2,
lwd = 2
)
text(
x = pos_x,
y = tabla_graficos$P_acumulada,
labels = round(tabla_graficos$P_acumulada,2),
pos = 3,
font = 2,
cex = 0.80
)
# ==========================================
# Eliminar la fila TOTAL
# ==========================================
tabla_sin_total <- tabla_probabilidad_total %>%
filter(Categoria != "TOTAL")
# ==========================================
# Categoría de interés
# ==========================================
categoria_interes <- "Deslizamiento de tierra"
# ==========================================
# Probabilidad empírica
# ==========================================
probabilidad <- tabla_sin_total$P[
tabla_sin_total$Categoria == categoria_interes
]
probabilidad
## [1] 69.3256
plot(
1,
type = "n",
axes = FALSE,
xlab = "",
ylab = ""
)
texto <- paste0(
"Estimación empírica de la probabilidad\n\n",
"La probabilidad de que un deslizamiento\n",
"seleccionado aleatoriamente pertenezca a la\n",
"categoría:\n\n",
"'", categoria_interes, "'\n\n",
"es de ", round(probabilidad,2), "%."
)
text(
x = 1,
y = 1,
labels = texto,
cex = 1.20,
font = 2
)
El análisis de la variable cualitativa nominal categoría de deslizamiento permitió estimar la distribución de probabilidad de 11032 eventos registrados, agrupados en 7 categorías.
La mayor probabilidad corresponde a la categoría Deslizamiento de tierra, con una probabilidad de 69.33 %, lo que evidencia que este constituye el tipo de deslizamiento más frecuente dentro de la base de datos analizada a escala mundial.