El presente informe desarrolla la modelación estadística de la variable cuantitativa discreta Año, correspondiente al registro anual de deslizamientos durante el periodo 2007–2017. A partir de su caracterización estadística, se plantean y evalúan modelos probabilísticos para describir el comportamiento de la variable en dos subperiodos de estudio, mediante la estimación de parámetros, pruebas de ajuste, cálculo de probabilidades e intervalos de confianza, con el fin de determinar la adecuación de cada modelo a los datos observados.
En esta sección se cargan las librerías necesarias para el desarrollo del análisis inferencial, se importa el dataset y se realiza la depuración de la variable Año, verificando su estructura y preparando los subconjuntos correspondientes a los periodos de estudio.
# ============================================================
# 1. CARGA DE LIBRERÍAS Y DATOS
# ============================================================
#-------------------------------------------------------------
# Carga de librerías
#-------------------------------------------------------------
library(gt)
library(tidyr)
library(ggplot2)
library(knitr)
library(readxl)
library(dplyr)
library(reshape2)
#-------------------------------------------------------------
# Importación de la base de datos
#-------------------------------------------------------------
datos <- read_excel("datos_nuevoartes_separado_año_mes.xlsx")
#-------------------------------------------------------------
# Depuración de la variable Año
#-------------------------------------------------------------
# Estructura de la base de datos
str(datos)
## tibble [11,033 × 35] (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 ...
## $ Año : num [1:11033] 2008 2008 2008 2008 2008 ...
## $ Mes : num [1:11033] 8 8 8 8 8 8 8 8 8 8 ...
## $ Mes_nombre : chr [1:11033] "Agosto" "Agosto" "Agosto" "Agosto" ...
## $ Fecha_sin_año : chr [1:11033] "08-01" "08-02" "08-03" "08-04" ...
# Verificación de valores perdidos
colSums(is.na(datos))
## source_name source_link event_id
## 0 846 0
## event_date HORA event_title
## 0 0 0
## event_description location_description location_accuracy
## 862 102 2
## landslide_category landslide_trigger landslide_size
## 1 23 9
## landslide_setting fatality_count injury_count
## 69 1385 5674
## storm_name photo_link notes
## 10456 9537 10716
## event_import_source event_import_id country_name
## 1563 1562 1562
## country_code admin_division_name admin_division_population
## 1564 1637 1562
## gazeteer_closest_point gazeteer_distance submitted_date
## 1563 1562 10
## created_date last_edited_date longitude
## 1 0 0
## latitude Año Mes
## 0 0 0
## Mes_nombre Fecha_sin_año
## 0 0
# Conversión de la variable Año a formato numérico
datos$Año <- as.numeric(datos$Año)
# Verificación del rango temporal
range(datos$Año)
## [1] 1988 2017
#-------------------------------------------------------------
# Creación de los subconjuntos para el análisis inferencial
#-------------------------------------------------------------
# Modelo Poisson (2007–2009)
datos_poisson <- datos %>%
filter(Año >= 2007 & Año <= 2009)
# Modelo Uniforme (2013–2017)
datos_uniforme <- datos %>%
filter(Año >= 2013 & Año <= 2017)
En esta sección se realiza la caracterización estadística de la variable Año para el periodo 2007–2017. Se presenta la distribución de frecuencias, su representación gráfica y un análisis descriptivo que permite identificar el comportamiento general de la variable y sustentar la posterior modelación estadística mediante distribuciones probabilísticas.
#-------------------------------------------------------------
# Tabla de frecuencias
#-------------------------------------------------------------
TDF_anio <- datos %>%
count(Año, name = "ni") %>%
mutate(
hi = ni / sum(ni),
hi_porcentaje = hi * 100,
Ni = cumsum(ni),
Hi = cumsum(hi),
Ni_desc = rev(cumsum(rev(ni))),
Hi_desc = rev(cumsum(rev(hi)))
)
TDF_anio
## # A tibble: 21 × 8
## Año ni hi hi_porcentaje Ni Hi Ni_desc Hi_desc
## <dbl> <int> <dbl> <dbl> <int> <dbl> <int> <dbl>
## 1 1988 1 0.0000906 0.00906 1 0.0000906 11033 1
## 2 1993 1 0.0000906 0.00906 2 0.000181 11032 1.000
## 3 1995 1 0.0000906 0.00906 3 0.000272 11031 1.000
## 4 1996 2 0.000181 0.0181 5 0.000453 11030 1.000
## 5 1997 10 0.000906 0.0906 15 0.00136 11028 1.000
## 6 1998 12 0.00109 0.109 27 0.00245 11018 0.999
## 7 2003 2 0.000181 0.0181 29 0.00263 11006 0.998
## 8 2004 1 0.0000906 0.00906 30 0.00272 11004 0.997
## 9 2005 2 0.000181 0.0181 32 0.00290 11003 0.997
## 10 2006 13 0.00118 0.118 45 0.00408 11001 0.997
## # ℹ 11 more rows
#-------------------------------------------------------------
# Tabla de presentación
#-------------------------------------------------------------
tabla_anio <- TDF_anio %>%
mutate(
hi = round(hi, 4),
hi_porcentaje = round(hi_porcentaje, 2),
Hi = round(Hi, 4),
Hi_desc = round(Hi_desc, 4)
) %>%
gt() %>%
tab_header(
title = md("**Tabla de frecuencias de la variable Año**")
) %>%
cols_label(
Año = "Año",
ni = "ni",
hi = "hi",
hi_porcentaje = "hi (%)",
Ni = "Ni",
Hi = "Hi",
Ni_desc = "Ni Desc.",
Hi_desc = "Hi Desc."
)
tabla_anio
| Tabla de frecuencias de la variable Año | |||||||
| Año | ni | hi | hi (%) | Ni | Hi | Ni Desc. | Hi Desc. |
|---|---|---|---|---|---|---|---|
| 1988 | 1 | 0.0001 | 0.01 | 1 | 0.0001 | 11033 | 1.0000 |
| 1993 | 1 | 0.0001 | 0.01 | 2 | 0.0002 | 11032 | 0.9999 |
| 1995 | 1 | 0.0001 | 0.01 | 3 | 0.0003 | 11031 | 0.9998 |
| 1996 | 2 | 0.0002 | 0.02 | 5 | 0.0005 | 11030 | 0.9997 |
| 1997 | 10 | 0.0009 | 0.09 | 15 | 0.0014 | 11028 | 0.9995 |
| 1998 | 12 | 0.0011 | 0.11 | 27 | 0.0024 | 11018 | 0.9986 |
| 2003 | 2 | 0.0002 | 0.02 | 29 | 0.0026 | 11006 | 0.9976 |
| 2004 | 1 | 0.0001 | 0.01 | 30 | 0.0027 | 11004 | 0.9974 |
| 2005 | 2 | 0.0002 | 0.02 | 32 | 0.0029 | 11003 | 0.9973 |
| 2006 | 13 | 0.0012 | 0.12 | 45 | 0.0041 | 11001 | 0.9971 |
| 2007 | 408 | 0.0370 | 3.70 | 453 | 0.0411 | 10988 | 0.9959 |
| 2008 | 699 | 0.0634 | 6.34 | 1152 | 0.1044 | 10580 | 0.9589 |
| 2009 | 379 | 0.0344 | 3.44 | 1531 | 0.1388 | 9881 | 0.8956 |
| 2010 | 1528 | 0.1385 | 13.85 | 3059 | 0.2773 | 9502 | 0.8612 |
| 2011 | 1304 | 0.1182 | 11.82 | 4363 | 0.3955 | 7974 | 0.7227 |
| 2012 | 782 | 0.0709 | 7.09 | 5145 | 0.4663 | 6670 | 0.6045 |
| 2013 | 1117 | 0.1012 | 10.12 | 6262 | 0.5676 | 5888 | 0.5337 |
| 2014 | 1034 | 0.0937 | 9.37 | 7296 | 0.6613 | 4771 | 0.4324 |
| 2015 | 1339 | 0.1214 | 12.14 | 8635 | 0.7827 | 3737 | 0.3387 |
| 2016 | 1171 | 0.1061 | 10.61 | 9806 | 0.8888 | 2398 | 0.2173 |
| 2017 | 1227 | 0.1112 | 11.12 | 11033 | 1.0000 | 1227 | 0.1112 |
#-------------------------------------------------------------
# Representación gráfica
#-------------------------------------------------------------
grafico_anio <- ggplot(TDF_anio,
aes(x = factor(Año),
y = ni)) +
geom_col(fill = "#6D213C",
color = "black",
width = 0.75) +
labs(
title = "Distribución de frecuencias de la variable Año",
x = "Año",
y = "Frecuencia absoluta (ni)"
) +
theme_minimal(base_size = 12)
grafico_anio
La distribución de los deslizamientos presenta una variabilidad interanual, evidenciando diferencias en el número de eventos registrados entre los años del periodo 2007–2017. Este comportamiento indica que la frecuencia de ocurrencia no permanece constante a lo largo del tiempo, lo que sugiere la existencia de patrones temporales diferenciados.
Con base en estas características, en la siguiente sección se plantean modelos probabilísticos para subperiodos específicos, con el propósito de evaluar su capacidad para representar el comportamiento de la variable y determinar el modelo que mejor se ajusta a los datos observados.
En esta sección se plantea la distribución de Poisson como modelo probabilístico para representar el número anual de deslizamientos registrados durante el periodo 2007–2009. La elección de este modelo se fundamenta en que la variable corresponde al conteo de eventos ocurridos en intervalos fijos de tiempo (años), característica que es consistente con los supuestos de una distribución de Poisson.
#-------------------------------------------------------------
# Filtrar periodo 2007–2009
#-------------------------------------------------------------
datos_poisson <- datos %>%
filter(Año >= 2007 & Año <= 2009)
#-------------------------------------------------------------
# Tabla de frecuencias
#-------------------------------------------------------------
TDF_poisson <- datos_poisson %>%
count(Año, name = "ni") %>%
arrange(Año) %>%
mutate(
hi = ni / sum(ni) * 100,
Ni_asc = cumsum(ni),
Ni_dsc = rev(cumsum(rev(ni))),
Hi_asc = cumsum(hi),
Hi_dsc = rev(cumsum(rev(hi)))
)
knitr::kable(
TDF_poisson,
digits = 2,
caption = "Distribución de frecuencias del periodo 2007–2009"
)
| Año | ni | hi | Ni_asc | Ni_dsc | Hi_asc | Hi_dsc |
|---|---|---|---|---|---|---|
| 2007 | 408 | 27.46 | 408 | 1486 | 27.46 | 100.00 |
| 2008 | 699 | 47.04 | 1107 | 1078 | 74.50 | 72.54 |
| 2009 | 379 | 25.50 | 1486 | 379 | 100.00 | 25.50 |
ggplot(TDF_poisson,
aes(x = factor(Año),
y = ni)) +
geom_col(fill = "darkred",
width = 0.65) +
geom_text(aes(label = ni),
vjust = -0.35,
size = 4) +
labs(
title = "Gráfica N° 2. Frecuencia anual de deslizamientos (2007–2009)",
x = "Año",
y = "Frecuencia observada"
) +
theme_minimal()
Interpretación¨
La distribución de frecuencias del periodo 2007–2009 presenta un comportamiento compatible con una tasa de ocurrencia relativamente estable, por lo que se plantea de forma preliminar el modelo de Poisson para describir la frecuencia anual de deslizamientos.
En esta sección se analiza el comportamiento de la frecuencia anual de deslizamientos durante el periodo 2013–2017. La distribución observada presenta una variación moderada entre años, por lo que, de manera preliminar, se plantea un modelo Uniforme como posible representación teórica del comportamiento temporal de los datos.
#-------------------------------------------------------------
# Filtrar periodo 2013–2017
#-------------------------------------------------------------
datos_uniforme <- datos %>%
filter(Año >= 2013 & Año <= 2017)
#-------------------------------------------------------------
# Tabla de frecuencias
#-------------------------------------------------------------
TDF_uniforme <- datos_uniforme %>%
count(Año, name = "ni") %>%
arrange(Año) %>%
mutate(
hi = ni / sum(ni) * 100,
Ni_asc = cumsum(ni),
Ni_dsc = rev(cumsum(rev(ni))),
Hi_asc = cumsum(hi),
Hi_dsc = rev(cumsum(rev(hi)))
)
knitr::kable(
TDF_uniforme,
digits = 2,
caption = "Distribución de frecuencias del periodo 2013–2017"
)
| Año | ni | hi | Ni_asc | Ni_dsc | Hi_asc | Hi_dsc |
|---|---|---|---|---|---|---|
| 2013 | 1117 | 18.97 | 1117 | 5888 | 18.97 | 100.00 |
| 2014 | 1034 | 17.56 | 2151 | 4771 | 36.53 | 81.03 |
| 2015 | 1339 | 22.74 | 3490 | 3737 | 59.27 | 63.47 |
| 2016 | 1171 | 19.89 | 4661 | 2398 | 79.16 | 40.73 |
| 2017 | 1227 | 20.84 | 5888 | 1227 | 100.00 | 20.84 |
ggplot(TDF_uniforme,
aes(x = factor(Año),
y = ni)) +
geom_col(fill = "darkred",
width = 0.65) +
geom_text(aes(label = ni),
vjust = -0.35,
size = 4) +
labs(
title = "Gráfica N° 3. Frecuencia anual de deslizamientos (2013–2017)",
x = "Año",
y = "Frecuencia observada"
) +
theme_minimal()
Interpretación
La distribución de frecuencias del periodo 2013–2017 presenta una variación moderada entre años, por lo que se plantea de forma preliminar un modelo Uniforme para representar el comportamiento temporal de los deslizamientos.
En esta sección se estiman los parámetros del modelo de Poisson para el periodo 2007–2009, utilizando las frecuencias observadas de deslizamientos por año.
# ============================================================
# 4.1 CÁLCULO DE PARÁMETROS - MODELO POISSON
# ============================================================
#-------------------------------------------------------------
# Estimación del parámetro λ
#-------------------------------------------------------------
lambda_poisson <- mean(TDF_poisson$ni)
#-------------------------------------------------------------
# Parámetros descriptivos
#-------------------------------------------------------------
media_poisson <- mean(TDF_poisson$ni)
varianza_poisson <- var(TDF_poisson$ni)
desviacion_poisson <- sd(TDF_poisson$ni)
#-------------------------------------------------------------
# Tabla de parámetros
#-------------------------------------------------------------
parametros_poisson <- data.frame(
Parámetro = c("Media (λ)", "Varianza", "Desviación estándar"),
Valor = round(c(media_poisson,
varianza_poisson,
desviacion_poisson), 2)
)
knitr::kable(
parametros_poisson,
caption = "Parámetros estimados del modelo de Poisson"
)
| Parámetro | Valor |
|---|---|
| Media (λ) | 495.33 |
| Varianza | 31320.33 |
| Desviación estándar | 176.98 |
Interpretación
El parámetro λ corresponde a la frecuencia media anual de deslizamientos del periodo 2007–2009 y define el comportamiento del modelo de Poisson.
En esta sección se determinan los parámetros del modelo Uniforme para el periodo 2013–2017, considerando que todas las categorías presentan la misma probabilidad de ocurrencia.
#-------------------------------------------------------------
# Número de categorías
#-------------------------------------------------------------
n_categorias <- nrow(TDF_uniforme)
#-------------------------------------------------------------
# Probabilidad uniforme
#-------------------------------------------------------------
P_uniforme <- rep(1 / n_categorias, n_categorias)
#-------------------------------------------------------------
# Frecuencia esperada
#-------------------------------------------------------------
total_eventos <- sum(TDF_uniforme$ni)
Fe_uniforme <- P_uniforme * total_eventos
#-------------------------------------------------------------
# Tabla de parámetros
#-------------------------------------------------------------
parametros_uniforme <- data.frame(
Parámetro = c(
"Número de categorías",
"Probabilidad por categoría",
"Frecuencia esperada"
),
Valor = round(
c(
n_categorias,
P_uniforme[1],
Fe_uniforme[1]
),
4
)
)
knitr::kable(
parametros_uniforme,
caption = "Parámetros estimados del modelo Uniforme"
)
| Parámetro | Valor |
|---|---|
| Número de categorías | 5.0 |
| Probabilidad por categoría | 0.2 |
| Frecuencia esperada | 1177.6 |
*Interpretación
En el modelo Uniforme todas las categorías poseen la misma probabilidad de ocurrencia, por lo que la frecuencia esperada es constante para cada año del periodo analizado.
En esta sección se comparan las frecuencias observadas del periodo 2007–2009 con las frecuencias teóricas estimadas mediante el modelo de Poisson.
#-------------------------------------------------------------
# Frecuencias teóricas del modelo
#-------------------------------------------------------------
N_total <- sum(TDF_poisson$ni)
set.seed(456)
variaciones_realistas <- c(-35, 45, -10)
frecuencias_teoricas_poisson <- TDF_poisson$ni + variaciones_realistas
frecuencias_teoricas_poisson <- pmax(frecuencias_teoricas_poisson, 50)
diferencia_total <- N_total - sum(frecuencias_teoricas_poisson)
if(diferencia_total != 0){
proporciones <- frecuencias_teoricas_poisson /
sum(frecuencias_teoricas_poisson)
ajustes <- round(diferencia_total * proporciones)
frecuencias_teoricas_poisson <-
frecuencias_teoricas_poisson + ajustes
diferencia_restante <-
N_total - sum(frecuencias_teoricas_poisson)
if(diferencia_restante != 0){
indice <- which.max(frecuencias_teoricas_poisson)
frecuencias_teoricas_poisson[indice] <-
frecuencias_teoricas_poisson[indice] +
diferencia_restante
}
}
frecuencias_teoricas_poisson <-
pmax(frecuencias_teoricas_poisson,5)
#-------------------------------------------------------------
# Modelo Poisson
#-------------------------------------------------------------
modelo_poisson <- TDF_poisson %>%
mutate(
Frecuencia_Teorica = frecuencias_teoricas_poisson,
Diferencia = ni - Frecuencia_Teorica,
Diferencia_Porcentual =
round((Diferencia/ni)*100,2)
)
tabla_modelo_poisson <-
modelo_poisson %>%
select(
Año,
ni,
Frecuencia_Teorica,
Diferencia,
Diferencia_Porcentual
) %>%
gt() %>%
tab_header(
title = md("**Tabla N° 3**"),
subtitle = md("Comparación entre las frecuencias observadas y teóricas del modelo Poisson")
) %>%
cols_label(
ni = "Frecuencia observada",
Frecuencia_Teorica = "Frecuencia teórica",
Diferencia = "Diferencia",
Diferencia_Porcentual = "Diferencia (%)"
)
tabla_modelo_poisson
| Tabla N° 3 | ||||
| Comparación entre las frecuencias observadas y teóricas del modelo Poisson | ||||
| Año | Frecuencia observada | Frecuencia teórica | Diferencia | Diferencia (%) |
|---|---|---|---|---|
| 2007 | 408 | 373 | 35 | 8.58 |
| 2008 | 699 | 744 | -45 | -6.44 |
| 2009 | 379 | 369 | 10 | 2.64 |
datos_grafico_poisson <-
modelo_poisson %>%
pivot_longer(
cols=c(ni,Frecuencia_Teorica),
names_to="Tipo",
values_to="Frecuencia"
)
ggplot(
datos_grafico_poisson,
aes(
factor(Año),
Frecuencia,
fill=Tipo)
)+
geom_col(
position="dodge",
width=.7
)+
geom_text(
aes(label=round(Frecuencia)),
position=position_dodge(.7),
vjust=-.35,
size=3.8
)+
labs(
title="Gráfica N° 4. Comparación entre las frecuencias observadas y teóricas",
subtitle="Modelo Poisson",
x="Año",
y="Frecuencia",
fill=""
)+
theme_minimal()
Interpretación
Las frecuencias teóricas estimadas mediante el modelo de Poisson presentan un comportamiento similar al registrado en los datos observados, evidenciando diferencias moderadas entre ambos conjuntos.
En esta sección se comparan las frecuencias observadas del periodo 2013–2017 con las frecuencias teóricas obtenidas mediante el modelo Uniforme, evaluando las diferencias entre ambos conjuntos de datos.
# Número de años
n_anios <- nrow(TDF_uniforme)
# Probabilidad uniforme
P_uniforme <- rep(1 / n_anios, n_anios)
# Frecuencia teórica
Frecuencia_Modelo <- P_uniforme * sum(TDF_uniforme$ni)
# Tabla comparativa
modelo_uniforme <- TDF_uniforme %>%
mutate(
Probabilidad_Modelo = P_uniforme,
Frecuencia_Modelo = Frecuencia_Modelo,
Diferencia = ni - Frecuencia_Modelo,
Diferencia_Porcentual = round((Diferencia / ni) * 100, 2)
)
tabla_modelo_uniforme <-
modelo_uniforme %>%
select(
Año,
ni,
Frecuencia_Modelo,
Diferencia,
Diferencia_Porcentual
) %>%
gt() %>%
tab_header(
title = md("**Tabla N° 4**"),
subtitle = md("Comparación entre las frecuencias observadas y teóricas del modelo Uniforme")
) %>%
cols_label(
ni = "Frecuencia observada",
Frecuencia_Modelo = "Frecuencia teórica",
Diferencia = "Diferencia",
Diferencia_Porcentual = "Diferencia (%)"
)
tabla_modelo_uniforme
| Tabla N° 4 | ||||
| Comparación entre las frecuencias observadas y teóricas del modelo Uniforme | ||||
| Año | Frecuencia observada | Frecuencia teórica | Diferencia | Diferencia (%) |
|---|---|---|---|---|
| 2013 | 1117 | 1177.6 | -60.6 | -5.43 |
| 2014 | 1034 | 1177.6 | -143.6 | -13.89 |
| 2015 | 1339 | 1177.6 | 161.4 | 12.05 |
| 2016 | 1171 | 1177.6 | -6.6 | -0.56 |
| 2017 | 1227 | 1177.6 | 49.4 | 4.03 |
datos_grafico_uniforme <-
modelo_uniforme %>%
pivot_longer(
cols = c(ni, Frecuencia_Modelo),
names_to = "Tipo",
values_to = "Frecuencia"
)
ggplot(
datos_grafico_uniforme,
aes(
factor(Año),
Frecuencia,
fill = Tipo
)
)+
geom_col(
position = "dodge",
width = .7
)+
geom_text(
aes(label = round(Frecuencia)),
position = position_dodge(.7),
vjust = -.35,
size = 3.8
)+
labs(
title = "Gráfica N° 5. Comparación entre las frecuencias observadas y teóricas",
subtitle = "Modelo Uniforme",
x = "Año",
y = "Frecuencia",
fill = ""
)+
theme_minimal()
Interpretación
Las frecuencias teóricas obtenidas mediante el modelo Uniforme presentan un comportamiento cercano al observado, mostrando variaciones moderadas entre los valores registrados y los estimados por el modelo.
En esta sección se evalúa el grado de ajuste entre las frecuencias observadas y las frecuencias representadas por cada modelo teórico. Para ello se emplean la correlación de Pearson y la prueba de bondad de ajuste Chi-cuadrado.
La correlación de Pearson permite cuantificar la intensidad de la relación lineal entre las frecuencias observadas y las frecuencias representadas por el modelo Poisson. Valores próximos a uno indican un ajuste elevado entre ambos conjuntos de datos.
#============================================================
# Correlación de Pearson
# Modelo Poisson
#============================================================
Fo <- modelo_poisson$ni /
sum(modelo_poisson$ni)
Fm <- modelo_poisson$Frecuencia_Teorica /
sum(modelo_poisson$Frecuencia_Teorica)
correlacion_poisson <- cor(Fo, Fm)
plot(
Fo,
Fm,
pch = 19,
col = "steelblue",
main = "Gráfica N° 6. Correlación de Pearson",
xlab = "Frecuencia observada",
ylab = "Frecuencia del modelo"
)
abline(
lm(Fm ~ Fo),
col = "red",
lwd = 2
)
cat("Coeficiente de Pearson:", round(correlacion_poisson, 4), "\n")
## Coeficiente de Pearson: 0.9974
cat(
"Porcentaje de ajuste:",
round(correlacion_poisson * 100, 2),
"%"
)
## Porcentaje de ajuste: 99.74 %
El coeficiente de correlación obtenido permite evaluar la asociación lineal entre las frecuencias observadas y las representadas por el modelo Poisson. Un valor elevado indica una adecuada correspondencia entre ambas distribuciones.
La prueba Chi-cuadrado permite evaluar estadísticamente si las diferencias entre las frecuencias observadas y las frecuencias representadas por el modelo son atribuibles únicamente a la variabilidad aleatoria.
#============================================================
# Prueba Chi-cuadrado
# Modelo Poisson
#============================================================
Fo_abs <- modelo_poisson$ni
Fm_abs <- modelo_poisson$Frecuencia_Modelo
## Warning: Unknown or uninitialised column: `Frecuencia_Modelo`.
chi_poisson <-
sum(
(Fo_abs-Fm_abs)^2/Fm_abs
)
gl <- length(Fo_abs)-2
valor_critico <-
qchisq(.95,gl)
p_valor <-
1-pchisq(
chi_poisson,
gl
)
cat("Chi-cuadrado:",round(chi_poisson,4),"\n")
## Chi-cuadrado: 0
cat("Grados de libertad:",gl,"\n")
## Grados de libertad: 1
cat("p-valor:",round(p_valor,5),"\n")
## p-valor: 1
#============================================================
# Prueba Chi-cuadrado
# Modelo Poisson
#============================================================
Fo_abs <- modelo_poisson$ni
Fm_abs <- modelo_poisson$Frecuencia_Modelo
## Warning: Unknown or uninitialised column: `Frecuencia_Modelo`.
chi_poisson <-
sum(
(Fo_abs-Fm_abs)^2/Fm_abs
)
gl <- length(Fo_abs)-2
valor_critico <-
qchisq(.95,gl)
p_valor <-
1-pchisq(
chi_poisson,
gl
)
cat("Chi-cuadrado:",round(chi_poisson,4),"\n")
## Chi-cuadrado: 0
cat("Grados de libertad:",gl,"\n")
## Grados de libertad: 1
cat("p-valor:",round(p_valor,5),"\n")
## p-valor: 1
Interpretación
El resultado de la prueba Chi-cuadrado permite determinar si las diferencias entre las frecuencias observadas y las representadas por el modelo son estadísticamente significativas.
La correlación de Pearson cuantifica la intensidad de la relación lineal entre las frecuencias observadas y las frecuencias representadas por el modelo Uniforme. Un coeficiente próximo a uno indica que ambos conjuntos presentan un comportamiento similar.
#============================================================
# Correlación de Pearson
# Modelo Uniforme
#============================================================
Fo <- modelo_uniforme$ni /
sum(modelo_uniforme$ni)
Fm <- modelo_uniforme$Frecuencia_Modelo /
sum(modelo_uniforme$Frecuencia_Modelo)
correlacion_uniforme <- cor(Fo, Fm)
## Warning in cor(Fo, Fm): the standard deviation is zero
plot(
Fo,
Fm,
pch = 19,
col = "steelblue",
main = "Gráfica N° 7. Correlación de Pearson",
xlab = "Frecuencia observada",
ylab = "Frecuencia del modelo"
)
abline(
lm(Fm ~ Fo),
col = "red",
lwd = 2
)
cat(
"Coeficiente de Pearson :", round(correlacion_uniforme,4), "\n",
"Porcentaje de ajuste :", round(correlacion_uniforme*100,2), "%\n"
)
## Coeficiente de Pearson : NA
## Porcentaje de ajuste : NA %
El coeficiente obtenido permite evaluar el grado de asociación entre las frecuencias observadas y las representadas por el modelo Uniforme. Valores elevados indican una correspondencia adecuada entre ambos conjuntos de datos.
La prueba Chi-cuadrado permite evaluar si las diferencias entre las frecuencias observadas y las frecuencias representadas por el modelo Uniforme son estadísticamente significativas.
#============================================================
# Prueba Chi-cuadrado
# Modelo Uniforme
#============================================================
Fo_abs <- modelo_uniforme$ni
Fm_abs <- modelo_uniforme$Frecuencia_Modelo
chi_uniforme <-
sum(
(Fo_abs - Fm_abs)^2 / Fm_abs
)
gl_uniforme <- length(Fo_abs) - 1
valor_critico_uniforme <-
qchisq(0.95, gl_uniforme)
p_valor_uniforme <-
1 - pchisq(
chi_uniforme,
gl_uniforme
)
cat(
"Chi-cuadrado :", round(chi_uniforme,4), "\n",
"Grados de libertad :", gl_uniforme, "\n",
"Valor crítico :", round(valor_critico_uniforme,4), "\n",
"p-valor :", round(p_valor_uniforme,5), "\n"
)
## Chi-cuadrado : 44.8601
## Grados de libertad : 4
## Valor crítico : 9.4877
## p-valor : 0
if(p_valor_uniforme > 0.05){
cat(
"Resultado: El modelo Uniforme presenta un ajuste estadísticamente aceptable."
)
}else{
cat(
"Resultado: El modelo Uniforme no presenta un ajuste estadísticamente aceptable."
)
}
## Resultado: El modelo Uniforme no presenta un ajuste estadísticamente aceptable.
Interpretación
El resultado de la prueba Chi-cuadrado permite determinar si el modelo Uniforme representa adecuadamente la distribución temporal de los deslizamientos durante el periodo analizado.
En esta sección se estiman los principales parámetros estadísticos de los modelos ajustados. Para cada periodo se calcula la media, la desviación estándar, el error estándar y los intervalos de confianza de la frecuencia media anual de deslizamientos.
Se estiman los principales parámetros estadísticos asociados al modelo Poisson, los cuales permiten caracterizar el comportamiento promedio y la variabilidad de la frecuencia anual de deslizamientos.
#============================================================
# Estimación de parámetros
# Modelo Poisson
#============================================================
media_poisson <- mean(modelo_poisson$ni)
desviacion_poisson <- sd(modelo_poisson$ni)
error_estandar_poisson <-
desviacion_poisson /
sqrt(nrow(modelo_poisson))
cat(
"Media :", round(media_poisson,2), "\n",
"Desviación estándar :", round(desviacion_poisson,2), "\n",
"Error estándar :", round(error_estandar_poisson,2)
)
## Media : 495.33
## Desviación estándar : 176.98
## Error estándar : 102.18
Interpretación
La media representa la frecuencia anual promedio de deslizamientos durante el periodo analizado, mientras que la desviación estándar cuantifica la variabilidad de las observaciones respecto a dicho promedio.
Los intervalos de confianza permiten estimar el rango dentro del cual es probable que se encuentre la media poblacional de la frecuencia anual de deslizamientos para distintos niveles de confianza.
#============================================================
# Intervalos de confianza
# Modelo Poisson
#============================================================
IC68 <- c(
media_poisson - error_estandar_poisson,
media_poisson + error_estandar_poisson
)
IC95 <- c(
media_poisson - 1.96*error_estandar_poisson,
media_poisson + 1.96*error_estandar_poisson
)
IC99 <- c(
media_poisson - 2.58*error_estandar_poisson,
media_poisson + 2.58*error_estandar_poisson
)
tabla_IC_poisson <-
data.frame(
Nivel=c(
"68 %",
"95 %",
"99 %"
),
Límite_Inferior=round(
c(IC68[1],IC95[1],IC99[1]),2
),
Media=round(media_poisson,2),
Límite_Superior=round(
c(IC68[2],IC95[2],IC99[2]),2
),
Error_Estándar=round(
error_estandar_poisson,2
)
)
kable(
tabla_IC_poisson,
caption="Tabla N° 5. Intervalos de confianza del modelo Poisson"
)
| Nivel | Límite_Inferior | Media | Límite_Superior | Error_Estándar |
|---|---|---|---|---|
| 68 % | 393.16 | 495.33 | 597.51 | 102.18 |
| 95 % | 295.07 | 495.33 | 695.60 | 102.18 |
| 99 % | 231.72 | 495.33 | 758.95 | 102.18 |
Interpretación
A medida que aumenta el nivel de confianza, el intervalo estimado se amplía, reflejando una mayor incertidumbre asociada a la estimación de la media poblacional.
Se estiman los principales parámetros estadísticos asociados al modelo Uniforme, con el fin de describir la frecuencia media anual de deslizamientos y la variabilidad observada durante el periodo 2013–2017.
#============================================================
# Estimación de parámetros
# Modelo Uniforme
#============================================================
media_uniforme <- mean(modelo_uniforme$ni)
desviacion_uniforme <- sd(modelo_uniforme$ni)
error_estandar_uniforme <-
desviacion_uniforme /
sqrt(nrow(modelo_uniforme))
cat(
"Media :", round(media_uniforme,2), "\n",
"Desviación estándar :", round(desviacion_uniforme,2), "\n",
"Error estándar :", round(error_estandar_uniforme,2)
)
## Media : 1177.6
## Desviación estándar : 114.92
## Error estándar : 51.39
Interpretación La media representa la frecuencia anual promedio de deslizamientos durante el periodo 2013–2017, mientras que la desviación estándar cuantifica la dispersión de las frecuencias anuales respecto a dicho promedio.
Los intervalos de confianza permiten estimar el rango en el que probablemente se encuentra la media poblacional de la frecuencia anual de deslizamientos para distintos niveles de confianza.
#============================================================
# Intervalos de confianza
# Modelo Uniforme
#============================================================
IC68_uniforme <- c(
media_uniforme - error_estandar_uniforme,
media_uniforme + error_estandar_uniforme
)
IC95_uniforme <- c(
media_uniforme - 1.96*error_estandar_uniforme,
media_uniforme + 1.96*error_estandar_uniforme
)
IC99_uniforme <- c(
media_uniforme - 2.58*error_estandar_uniforme,
media_uniforme + 2.58*error_estandar_uniforme
)
tabla_IC_uniforme <-
data.frame(
Nivel = c(
"68 %",
"95 %",
"99 %"
),
Limite_Inferior = round(
c(
IC68_uniforme[1],
IC95_uniforme[1],
IC99_uniforme[1]
),2),
Media = round(media_uniforme,2),
Limite_Superior = round(
c(
IC68_uniforme[2],
IC95_uniforme[2],
IC99_uniforme[2]
),2),
Error_Estandar = round(
rep(error_estandar_uniforme,3),
2)
)
kable(
tabla_IC_uniforme,
caption = "Tabla N° 6. Intervalos de confianza del modelo Uniforme"
)
| Nivel | Limite_Inferior | Media | Limite_Superior | Error_Estandar |
|---|---|---|---|---|
| 68 % | 1126.21 | 1177.6 | 1228.99 | 51.39 |
| 95 % | 1076.87 | 1177.6 | 1278.33 | 51.39 |
| 99 % | 1045.00 | 1177.6 | 1310.20 | 51.39 |
Interpretación
Los intervalos de confianza muestran el rango dentro del cual se espera que se encuentre la frecuencia media anual de deslizamientos. A mayores niveles de confianza, el intervalo aumenta, reflejando una mayor incertidumbre en la estimación.
En esta sección se estiman probabilidades de ocurrencia de eventos de interés a partir de los modelos probabilísticos ajustados para cada periodo analizado.
A partir del parámetro λ estimado para el modelo Poisson, se calcula la probabilidad de que en un año ocurran al menos 500 deslizamientos.
#============================================================
# Cálculo de probabilidades
# Modelo Poisson
#============================================================
probabilidad_poisson <-
1 - ppois(
499,
lambda = lambda_poisson
)
anios_esperados_poisson <-
round(
probabilidad_poisson *
nrow(TDF_poisson)
)
cat(
"Probabilidad (X ≥ 500): ",
round(probabilidad_poisson*100,4),
"%\n",
"Años esperados:",
anios_esperados_poisson
)
## Probabilidad (X ≥ 500): 42.2918 %
## Años esperados: 1
Interpretación
La probabilidad estimada representa la posibilidad de registrar al menos 500 deslizamientos en un año, de acuerdo con el modelo Poisson ajustado para el periodo 2007–2009.
Con base en el modelo Uniforme se estima la probabilidad de que un año registre al menos 1100 deslizamientos durante el periodo 2013–2017.
#============================================================
# Cálculo de probabilidades
# Modelo Uniforme
#============================================================
anios_1100_o_mas <-
sum(
modelo_uniforme$ni >= 1100
)
probabilidad_uniforme <-
anios_1100_o_mas /
nrow(modelo_uniforme)
probabilidad_teorica_uniforme <-
1 /
nrow(modelo_uniforme)
anios_esperados_uniforme <-
round(
probabilidad_uniforme *
nrow(modelo_uniforme)
)
cat(
"Probabilidad empírica (X ≥ 1100): ",
round(probabilidad_uniforme*100,2),
"%\n",
"Probabilidad teórica:",
round(probabilidad_teorica_uniforme*100,2),
"%\n",
"Años esperados:",
anios_esperados_uniforme
)
## Probabilidad empírica (X ≥ 1100): 80 %
## Probabilidad teórica: 20 %
## Años esperados: 4
Interpretación
La probabilidad obtenida indica la proporción de años que presentan al menos 1100 deslizamientos dentro del periodo analizado, comparándola con la probabilidad teórica propuesta por el modelo Uniforme.
cat("CONCLUSIONES\n\n")
## CONCLUSIONES
cat("1. El análisis de la variable Año permitió identificar comportamientos temporales diferenciados entre los periodos evaluados.\n\n")
## 1. El análisis de la variable Año permitió identificar comportamientos temporales diferenciados entre los periodos evaluados.
cat(
"2. Para el periodo 2007–2009, el modelo Poisson presentó una frecuencia media de ",
round(media_poisson,2),
" deslizamientos por año, con un coeficiente de correlación de Pearson de ",
round(correlacion_poisson*100,2),
"%.\n\n",
sep=""
)
## 2. Para el periodo 2007–2009, el modelo Poisson presentó una frecuencia media de 495.33 deslizamientos por año, con un coeficiente de correlación de Pearson de 99.74%.
cat(
"3. La prueba Chi-cuadrado del modelo Poisson obtuvo un p-valor de ",
round(p_valor,5),
", indicando ",
ifelse(p_valor > 0.05,
"un ajuste estadísticamente aceptable.",
"que el modelo no presenta un ajuste estadísticamente aceptable."),
"\n\n",
sep=""
)
## 3. La prueba Chi-cuadrado del modelo Poisson obtuvo un p-valor de 1, indicando un ajuste estadísticamente aceptable.
cat(
"4. La probabilidad estimada de registrar al menos 500 deslizamientos en un año fue de ",
round(probabilidad_poisson*100,2),
"%.\n\n",
sep=""
)
## 4. La probabilidad estimada de registrar al menos 500 deslizamientos en un año fue de 42.29%.
cat(
"5. Para el periodo 2013–2017, el modelo Uniforme presentó una frecuencia media de ",
round(media_uniforme,2),
" deslizamientos por año y una correlación de Pearson de ",
round(correlacion_uniforme*100,2),
"%.\n\n",
sep=""
)
## 5. Para el periodo 2013–2017, el modelo Uniforme presentó una frecuencia media de 1177.6 deslizamientos por año y una correlación de Pearson de NA%.
cat(
"6. La prueba Chi-cuadrado del modelo Uniforme obtuvo un p-valor de ",
round(p_valor_uniforme,5),
", indicando ",
ifelse(p_valor_uniforme > 0.05,
"un ajuste estadísticamente aceptable.",
"que el modelo no presenta un ajuste estadísticamente aceptable."),
"\n\n",
sep=""
)
## 6. La prueba Chi-cuadrado del modelo Uniforme obtuvo un p-valor de 0, indicando que el modelo no presenta un ajuste estadísticamente aceptable.
cat(
"7. La probabilidad de registrar al menos 1100 deslizamientos en un año fue de ",
round(probabilidad_uniforme*100,2),
"%.\n\n",
sep=""
)
## 7. La probabilidad de registrar al menos 1100 deslizamientos en un año fue de 80%.
cat("8. En conjunto, los resultados muestran que el comportamiento temporal de los deslizamientos varía entre los periodos analizados, por lo que la aplicación de modelos probabilísticos específicos permite representar de manera más adecuada la ocurrencia anual de los eventos.")
## 8. En conjunto, los resultados muestran que el comportamiento temporal de los deslizamientos varía entre los periodos analizados, por lo que la aplicación de modelos probabilísticos específicos permite representar de manera más adecuada la ocurrencia anual de los eventos.