Esta variable cuantifica el impacto económico directo sobre activos físicos y el entorno tras un siniestro. Se compone principalmente de tres rubros:
No incluye el valor del producto perdido ni sanciones legales, por lo que mide estrictamente la “reconstrucción material” del lugar del evento.
library(moments)
library(readr)
datos <- read.csv("datasetf.csv", check.names = FALSE)
# 1. Convertir la columna con espacios a número de forma segura
# Usamos comillas invertidas ` ` para que R acepte los espacios
datos$`Property Damage Costs` <- as.numeric(as.character(datos$`Property Damage Costs`))
# 2. Limpiar NAs (si hay celdas vacías, las tratamos como 0 o las eliminamos)
# En este caso, creamos un vector limpio para los cálculos
costos_limpios <- datos$`Property Damage Costs`
costos_limpios[is.na(costos_limpios)] <- 0# 3. Aplicar la Regla de Sturges
n_c <- length(costos_limpios)
k_c <- ceiling(1 + 3.322 * log10(n_c))
rango_c <- max(costos_limpios) - min(costos_limpios)
amplitud_c <- rango_c / k_c
# 4. Crear intervalos y tabla
limites_c <- seq(min(costos_limpios), max(costos_limpios), length.out = k_c + 1)
Li <- limites_c[1:k_c]
Ls <- limites_c[2:(k_c + 1)]
MC <- (Li + Ls) / 2
ni <- as.vector(table(cut(costos_limpios, breaks = limites_c, include.lowest = TRUE)))
hi_porc <- (ni / n_c) * 100
Ni_asc <- cumsum(ni)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_asc_porc <- cumsum(hi_porc)
Hi_desc_porc <- rev(cumsum(rev(hi_porc)))
# 5. Tabla de Frecuencias Final
tabla_costos_damage <- data.frame(
Li = round(Li, 2), Ls = round(Ls, 2), MC = round(MC, 2),
ni = ni, hi_porc = round(hi_porc, 2),
Ni_asc = Ni_asc, Ni_desc = Ni_desc,
Hi_asc_porc = round(Hi_asc_porc, 2),
Hi_desc_porc = round(Hi_desc_porc, 2)
)
print(tabla_costos_damage)## Li Ls MC ni hi_porc Ni_asc Ni_desc Hi_asc_porc
## 1 0 2076923 1038462 2777 99.36 2777 2795 99.36
## 2 2076923 4153846 3115385 7 0.25 2784 18 99.61
## 3 4153846 6230769 5192308 4 0.14 2788 11 99.75
## 4 6230769 8307692 7269231 2 0.07 2790 7 99.82
## 5 8307692 10384615 9346154 1 0.04 2791 5 99.86
## 6 10384615 12461538 11423077 1 0.04 2792 4 99.89
## 7 12461538 14538462 13500000 1 0.04 2793 3 99.93
## 8 14538462 16615385 15576923 0 0.00 2793 2 99.93
## 9 16615385 18692308 17653846 0 0.00 2793 2 99.93
## 10 18692308 20769231 19730769 0 0.00 2793 2 99.93
## 11 20769231 22846154 21807692 0 0.00 2793 2 99.93
## 12 22846154 24923077 23884615 1 0.04 2794 2 99.96
## 13 24923077 27000000 25961538 1 0.04 2795 1 100.00
## Hi_desc_porc
## 1 100.00
## 2 0.64
## 3 0.39
## 4 0.25
## 5 0.18
## 6 0.14
## 7 0.11
## 8 0.07
## 9 0.07
## 10 0.07
## 11 0.07
## 12 0.07
## 13 0.04
Debido a la naturaleza de la variable “Property Damage Costs”, la distribución presenta un sesgo positivo extremo (cola larga). En la tabla de frecuencias global, el primer intervalo acumula la gran mayoría de la muestra, lo que genera una “pérdida de resolución” estadística.
Se realiza este movimiento para descomponer el intervalo [0 - 2,076,923], aplicando nuevamente la Regla de Sturges sobre este subconjunto. Esto permite: 1. Identificar la distribución interna de la siniestralidad más frecuente. 2. Evitar que los valores atípicos (outliers) extremos distorsionen la escala visual de los histogramas y la lectura de las ojivas. 3. Revelar la variabilidad oculta en el bloque de datos con mayor densidad.
# Usamos tus límites específicos: 0 a 2,076,923
limite_inf <- 0
limite_sup <- 2076923
datos_primer_intervalo <- costos_limpios[costos_limpios >= limite_inf & costos_limpios <= limite_sup]
# --- 2. APLICAR STURGES A ESTE SUB-RANGO ---
n_p <- length(datos_primer_intervalo)
k_p <- ceiling(1 + 3.322 * log10(n_p))
limites_p <- seq(limite_inf, limite_sup, length.out = k_p + 1)
# --- 3. CÁLCULO DE FRECUENCIAS ---
cortes_p <- cut(datos_primer_intervalo, breaks = limites_p, include.lowest = TRUE)
ni_p <- as.vector(table(cortes_p))
# Ajustar variables para la tabla (asegurando coincidencia de filas)
k_real_p <- length(ni_p)
Li_p <- limites_p[1:k_real_p]
Ls_p <- limites_p[2:(k_real_p + 1)]
MC_p <- (Li_p + Ls_p) / 2
hi_p_porc <- (ni_p / n_p) * 100
Ni_p_asc <- cumsum(ni_p)
Ni_p_desc <- rev(cumsum(rev(ni_p)))
Hi_p_asc_porc <- cumsum(hi_p_porc)
Hi_p_desc_porc <- rev(cumsum(rev(hi_p_porc)))
# --- 4. TABLA DE FRECUENCIAS (ZOOM PRIMER INTERVALO) ---
tabla_primer_int <- data.frame(
Li = round(Li_p, 2), Ls = round(Ls_p, 2), MC = round(MC_p, 2),
ni = ni_p, hi_porc = round(hi_p_porc, 2),
Ni_asc = Ni_p_asc, Ni_desc = Ni_p_desc,
Hi_asc_porc = round(Hi_p_asc_porc, 2),
Hi_desc_porc = round(Hi_desc_porc, 2)
)
print(tabla_primer_int)## Li Ls MC ni hi_porc Ni_asc Ni_desc Hi_asc_porc
## 1 0.0 159763.3 79881.65 2550 91.83 2550 2777 91.83
## 2 159763.3 319526.6 239644.96 93 3.35 2643 227 95.17
## 3 319526.6 479289.9 399408.27 38 1.37 2681 134 96.54
## 4 479289.9 639053.2 559171.58 27 0.97 2708 96 97.52
## 5 639053.2 798816.5 718934.88 11 0.40 2719 69 97.91
## 6 798816.5 958579.8 878698.19 12 0.43 2731 58 98.34
## 7 958579.8 1118343.1 1038461.50 16 0.58 2747 46 98.92
## 8 1118343.1 1278106.5 1198224.81 4 0.14 2751 30 99.06
## 9 1278106.5 1437869.8 1357988.12 2 0.07 2753 26 99.14
## 10 1437869.8 1597633.1 1517751.42 9 0.32 2762 24 99.46
## 11 1597633.1 1757396.4 1677514.73 3 0.11 2765 15 99.57
## 12 1757396.4 1917159.7 1837278.04 3 0.11 2768 12 99.68
## 13 1917159.7 2076923.0 1997041.35 9 0.32 2777 9 100.00
## Hi_desc_porc
## 1 100.00
## 2 0.64
## 3 0.39
## 4 0.25
## 5 0.18
## 6 0.14
## 7 0.11
## 8 0.07
## 9 0.07
## 10 0.07
## 11 0.07
## 12 0.07
## 13 0.04
hist(costos_limpios,
breaks = limites_c,
main = "Gráfica No. 1: Distribución de Costos de daños a la propiedad",
xlab = "Costo de Daños ($)",
ylab = "Cantidad",
col = "steelblue",
border = "white",
las = 1)hist(datos_primer_intervalo,
breaks = limites_p,
main = "Gráfica No. 2: Distribución de Costos de daños a la propiedad ",
xlab = "Costo de Daños ($)",
ylab = "Cantidad",
col = "steelblue",
border = "white",
las = 1)h_glob <- hist(costos_limpios, breaks = limites_c, plot = FALSE)
h_glob$counts <- (h_glob$counts / sum(h_glob$counts)) * 100 # Convertir a %
plot(h_glob,
main = "Gráfica No. 3:Distribución Porcentual de Costos de daños a la propiedad",
xlab = "Costo de Daños ($)", ylab = "Porcentaje (%)",
col = "cornflowerblue", border = "white", las = 1)h_prim <- hist(datos_primer_intervalo, breaks = limites_p, plot = FALSE)
h_prim$counts <- (h_prim$counts / sum(h_prim$counts)) * 100 # Convertir a %
plot(h_prim,
main = "Gráfica No. 4:Distribución Porcentual de Costos de daños a la propiedad)",
xlab = "Costo de Daños ($)", ylab = "Porcentaje (%)",
col = "steelblue", border = "white", las = 1)El hecho de que la ojiva suba de forma casi vertical al inicio del eje X y se estabilice rápidamente en la parte superior se debe a:
ALTA CONCENTRACIÓN EN EL ORIGEN: La pendiente pronunciada al principio indica que el mayor porcentaje de los datos (frecuencia acumulada) se alcanza con valores de costo extremadamente bajos (cercanos a 0).
DOMINIO DE EVENTOS MENORES: Visualmente, la ojiva nos dice que no hay una distribución gradual de costos. Más del 80% o 90% de los incidentes “se agotan” en los primeros tramos del gráfico.
EFECTO DE “COLA LARGA”: El tramo horizontal largo de la ojiva después del primer salto muestra que el resto de los costos (los más caros) son eventos aislados y escasos, que no aportan volumen de frecuencia pero sí extienden el eje horizontal.
plot(Ls_p, Ni_p_asc, type = "b", col = "blue", pch = 16, lwd = 2,
main = "Gráfica No 5: Comportamiento de Costos de daños a la propiedad",
xlab = "Costo de Daños ($))", ylab = "Número de Incidentes ",
las = 1, xaxt = "n") # Quitamos el eje X para personalizarlo
axis(1, at = seq(min(Ls_p), max(Ls_p), length.out = 5)) # Eje X simplificado
lines(Ls_p, Ni_p_desc, type = "b", col = "red", pch = 16, lwd = 2)
legend("right", legend = c("Ni Ascendente", "Ni Descendente"),
col = c("blue", "red"), lty = 1, pch = 16, bty = "n", cex = 0.8)
grid()boxplot(datos_primer_intervalo,
horizontal = TRUE,
main = "Gráfica No. 6: Distribución de Costos de daños a la propiedad",
col = "darkred",
xlab = "Costo de Daños ($)",
border = "darkblue",
pch = 18,
las = 1)
grid(nx = NULL, ny = NA, lty = 2, col = "gray")# Función para extraer indicadores
obtener_stats <- function(datos) {
c(
n = length(datos),
Media = mean(datos),
Mediana = median(datos),
SD = sd(datos),
CV_porc = (sd(datos) / mean(datos)) * 100,
Min = min(datos),
Max = max(datos),
Sesgo = skewness(datos),
Curtosis = kurtosis(datos)
)
}
# Cálculo de ambas columnas
stats_global <- obtener_stats(costos_limpios)
stats_zoom <- obtener_stats(datos_primer_intervalo)
# Creación del Dataframe comparativo
tabla_comparativa <- data.frame(
Indicador = c("Muestra (n)", "Media", "Mediana", "Desv. Estándar",
"CV (%)", "Mínimo", "Máximo", "Sesgo", "Curtosis"),
Global = round(stats_global, 2),
Zoom_Primer_Int = round(stats_zoom, 2)
)
# Imprimir resultado
print(tabla_comparativa)## Indicador Global Zoom_Primer_Int
## n Muestra (n) 2795.00 2777.00
## Media Media 112015.02 62162.51
## Mediana Mediana 3000.00 3000.00
## SD Desv. Estándar 869921.09 212641.76
## CV_porc CV (%) 776.61 342.07
## Min Mínimo 0.00 0.00
## Max Máximo 27000000.00 2072440.00
## Sesgo Sesgo 21.94 5.96
## Curtosis Curtosis 587.79 43.97
Los indicadores muestran una distribución de asimetría positiva extrema (Sesgo > 10). La estabilidad de la Mediana cerca del origen indica que la gran mayoría de los incidentes presentan costos mínimos o nulos, mientras que la Media se ve fuertemente influenciada por valores atípicos masivos (del orden de millones).
Este fenómeno estadístico justifica plenamente el uso del análisis de ‘Zoom’ (Primer Intervalo), ya que permite entender el comportamiento real y la dispersión de la gran mayoría de los casos, los cuales quedan “ocultos” en el análisis global por el peso visual y estadístico de los valores extremos.