Carga de Datos y Librerías Extraer la Variable Conclusión

1. CARGA DE DATOS Y LIBRERÍAS

# ==========================================
# 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 ...

2. EXTRAER LA VARIABLE

2.1 Consolidación de categorías

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

    )
  )

2.2 Extracción de la variable

# ==========================================
# 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"

2.3 Tratamiento de valores faltantes

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

3. DISTRIBUCIÓN DE PROBABILIDAD

3.1 Cálculo de frecuencias

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

3.2 Cálculo de probabilidades

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

3.3 Probabilidad acumulada

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

4. TABLA DE DISTRIBUCIÓN DE PROBABILIDAD

4.1 Tabla simple

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

4.2 Presentación de la tabla

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

5. GRÁFICAS DE LA DISTRIBUCIÓN DE PROBABILIDAD

5.1 Diagrama de barras de la 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

)

5.2 Diagrama de barras de la probabilidad acumulada

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

)

6. CÁLCULO DE LA PROBABILIDAD

6.1 Cálculo de la probabilidad

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

6.2 Interpretación de la probabilidad

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

)

7. CONCLUSIÓN

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.