ESTADÍSTICA DESCRIPTIVA: VARIABLES CONTINUAS
1 Latitud
1.1 Carga de datos
## 'data.frame': 3550 obs. of 23 variables:
## $ Id : int 6786 6250 8220 6241 6216 6620 6262 6229 6201 6221 ...
## $ Dia : int 19 3 21 16 19 7 10 12 18 29 ...
## $ Mes : int 1 6 4 3 12 10 2 5 3 1 ...
## $ Año : chr "A" "1979" "2010" "1978" ...
## $ Nombre : chr "Arabian Gulf Spills; Persian Gulf, Kuwait" "IXTOC I; Bahia de Campeche, Mexico" "Deepwater Horizon; Gulf of Mexico" "Amoco Cadiz; Brittany, France" ...
## $ Ubicacion : chr "Persian Gulf, Kuwait" "Bahia de Campeche, Mexico" "Gulf of Mexico" "Brittany, France" ...
## $ Latitud : chr "29,5" "19,4083" "28,7367" "48,5833" ...
## $ Longuitud : chr "48" "-92,325" "-88,3872" "-4,71667" ...
## $ Amenaza : chr "Oil" "Oil" "Oil" "Oil" ...
## $ Etiquetas : chr "" "Collision" "" "Grounding" ...
## $ Tipo_de_crudo : chr "Kuwait crude oil" "IXTOC I crude oil" "Diesel, crude oil" "Arabian light crude, Iranian light crude, Bunker C" ...
## $ Cantidad_recuperada_superficie : int NA NA 1 NA NA NA NA NA NA NA ...
## $ Cantidad_recuperada_costas : int NA NA 1 NA NA NA NA NA NA NA ...
## $ Cantidad_tratada_biologicamente : int 1 NA 1 1 NA NA NA NA NA NA ...
## $ Cantidad_dispersada_quimicamente: int NA 1 1 1 NA NA NA 1 1 1 ...
## $ Cantidad_quemada : int NA 1 1 NA NA NA NA 1 1 1 ...
## $ Maximo_liberacion_galones : int 336000009 NA 205000000 68000017 NA NA NA 9240000 36100000 NA ...
## $ Barreras_de_contencion_flotantes: int 35 12 182 17 3 3 7 8 5 6 ...
## $ Causa_principal : chr "Daño del tanque " "Incendio y explosion " "Incendio y explosion " "Daño del tanque " ...
## $ Volumen_derramados_galones : chr "336.000.000" "365.000.000" "600.000.000" "68.000.000" ...
## $ Respuesta_actual_galones : chr "336000000" "252000000" "168000000" "68700000" ...
## $ Fuente_respuesta : chr "description and posts" "posts" "description" "posts" ...
## $ etiqueta_actualizacion : chr "RA updated" "RA newly acquired" "RA updated" "RA updated" ...1.2 Extraer la variable
## Warning: NAs introduced by coercion1.3 Definir intervalos
min_lat <- floor(min(latitud, na.rm = TRUE)) - 0.001
max_lat <- ceiling(max(latitud, na.rm = TRUE)) + 0.001
breaks_Latitud <- seq(min_lat, max_lat, by = 5)
if (max_lat > max(breaks_Latitud)) {
breaks_Latitud <- c(breaks_Latitud, max_lat)
}
# Crear los rangos
rango_Latitud <- cut(latitud,
breaks = breaks_Latitud,
right = FALSE,
include.lowest = TRUE)
# TABLA DE FRECUENCIAS
TDF_Latitud <- table(rango_Latitud)
tabla_Latitud <- as.data.frame(TDF_Latitud)
hi_Latitud <- (tabla_Latitud$Freq / sum(tabla_Latitud$Freq)) * 100
tabla_Latitud$hi <- round(hi_Latitud, 2)
Niasc_Latitud <- cumsum(tabla_Latitud$Freq)
Hiasc_Latitud <- cumsum(hi_Latitud)
Nidsc_Latitud <- rev(cumsum(rev(tabla_Latitud$Freq)))
Hidsc_Latitud <- rev(cumsum(rev(hi_Latitud)))
tabla_Latitud_Final <- data.frame(
Rango_Latitud = levels(rango_Latitud),
Frecuencia = tabla_Latitud$Freq,
Porcentaje = tabla_Latitud$hi,
Niasc = Niasc_Latitud,
Hiasc = round(Hiasc_Latitud, 2),
Nidsc = Nidsc_Latitud,
Hidsc = round(Hidsc_Latitud, 2)
)
print(tabla_Latitud_Final)## Rango_Latitud Frecuencia Porcentaje Niasc Hiasc Nidsc Hidsc
## 1 [-78,-73) 1 3.57 1 3.57 28 100.00
## 2 [-73,-68) 0 0.00 1 3.57 27 96.43
## 3 [-68,-63) 0 0.00 1 3.57 27 96.43
## 4 [-63,-58) 0 0.00 1 3.57 27 96.43
## 5 [-58,-53) 0 0.00 1 3.57 27 96.43
## 6 [-53,-48) 1 3.57 2 7.14 27 96.43
## 7 [-48,-43) 0 0.00 2 7.14 26 92.86
## 8 [-43,-38) 0 0.00 2 7.14 26 92.86
## 9 [-38,-33) 1 3.57 3 10.71 26 92.86
## 10 [-33,-28) 0 0.00 3 10.71 25 89.29
## 11 [-28,-23) 0 0.00 3 10.71 25 89.29
## 12 [-23,-18) 0 0.00 3 10.71 25 89.29
## 13 [-18,-13) 0 0.00 3 10.71 25 89.29
## 14 [-13,-8) 0 0.00 3 10.71 25 89.29
## 15 [-8,-3) 0 0.00 3 10.71 25 89.29
## 16 [-3,2) 0 0.00 3 10.71 25 89.29
## 17 [2,7) 1 3.57 4 14.29 25 89.29
## 18 [7,12) 0 0.00 4 14.29 24 85.71
## 19 [12,17) 1 3.57 5 17.86 24 85.71
## 20 [17,22) 4 14.29 9 32.14 23 82.14
## 21 [22,27) 2 7.14 11 39.29 19 67.86
## 22 [27,32) 7 25.00 18 64.29 17 60.71
## 23 [32,37) 0 0.00 18 64.29 10 35.71
## 24 [37,42) 5 17.86 23 82.14 10 35.71
## 25 [42,47) 2 7.14 25 89.29 5 17.86
## 26 [47,52) 1 3.57 26 92.86 3 10.71
## 27 [52,57) 0 0.00 26 92.86 2 7.14
## 28 [57,61] 2 7.14 28 100.00 2 7.141.3.1 Histograma
h <- hist(latitud,
breaks = breaks_Latitud,
freq = TRUE,
main = "Frecuencia de la Latitud en los Derrames Globales",
xlab = "Latitud ",
ylab = "Frecuencia",
col = terrain.colors(length(tabla_Latitud_Final$Frecuencia)),
border = "black",
las = 1)## Warning in plot.histogram(r, freq = freq1, col = col, border = border, angle =
## angle, : the AREAS in the plot are wrong -- rather use 'freq = FALSE'
1.3.2 Diagrama de cajas
boxplot(
datos$Latitud,
horizontal = TRUE,
col = "beige",
main = " Diagrama de Caja de la Latitud en Derrames Petroleros a Nivel Global",
cex.main = 0.8,
xlab = "Latitud"
)
1.3.3 Ojiva ascendente y descendente
x_Latitud <- 1:length(tabla_Latitud_Final$Rango_Latitud)
y_ni_asc_Latitud <- tabla_Latitud_Final$Niasc
y_ni_dsc_Latitud <- tabla_Latitud_Final$Nidsc
plot(x_Latitud, y_ni_asc_Latitud,
type = "b",
main = " Ojivas de la Latitud en Derrames Petroleros a Nivel Global",
cex.main = 0.8,
xlab = " Latitud",
ylab = "Frecuencia acumulada",
col = "black")
lines(x_Latitud, y_ni_dsc_Latitud, col = "blue", type = "b")
grid()
# Leyenda más a la izquierda
legend("topleft", legend = c("Ascendente", "Descendente"),
col = c("black", "blue"), lty = 1, cex = 0.8, inset = c(0.02, 0.29))
1.3.4 Indicadores estadísticos
# Indicadores
Latitud_num <- as.numeric(datos$Latitud)
Latitud_num <- Latitud_num[!is.na(Latitud_num)]
library(e1071)
# Función para calcular la moda
get_mode <- function(v) {
v <- as.numeric(v)
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
# Medidas de tendencia central y dispersión
media <- mean(Latitud_num)
mediana <- median(Latitud_num)
moda <- get_mode(Latitud_num)
desv <- sd(Latitud_num)
varianza <- var(Latitud_num)
cv <- (desv / media) * 100
# Medidas de forma
asim <- skewness(Latitud_num)
curt <- kurtosis(Latitud_num)
# Tabla de indicadores
indicadores_Respuesta <- data.frame(
Indicador = c("Moda", "Mediana", "Media", "Desviación Estándar",
"Varianza", "Coef. de Variación (%)", "Asimetría", "Curtosis"),
Valor = c(round(moda, 2), round(mediana, 2), round(media, 2), round(desv, 2),
round(varianza, 2), round(cv, 2), round(asim, 2), round(curt, 2))
)
print("Indicadores estadísticos: Latitud en Derrames Petroleros a Nivel Global")## [1] "Indicadores estadísticos: Latitud en Derrames Petroleros a Nivel Global"## Indicador Valor
## Moda 30.00
## Mediana 30.00
## Media 22.79
## Desviación Estándar 30.90
## Varianza 954.69
## Coef. de Variación (%) 135.60
## Asimetría -1.81
## Curtosis 2.971.4 Conclusión
La mayoría de los derrames de petróleo se concentran entre las latitudes 10° y 40°, principalmente en el hemisferio norte, lo que evidencia una mayor actividad petrolera en zonas tropicales y subtropicales. Este patrón es coherente con los resultados estadísticos, donde la mediana y la moda iguales a 30° indican una clara concentración alrededor de este rango, mientras que la media de 22.79° y la asimetría negativa (-1.81) muestran un sesgo hacia latitudes menores.
La alta desviación estándar (30.90) y el coeficiente de variación del 135.60% confirman que los derrames presentan una amplia dispersión espacial, aunque son poco frecuentes en latitudes altas. Además, la curtosis cercana a 3 (2.97) sugiere una distribución moderadamente concentrada alrededor del valor central.
2 Longitud
2.1 Extraer la variable
## Warning: NAs introduced by coercion2.2 Definir intervalos
min_long <- floor(min(longitud, na.rm = TRUE)) - 0.001
max_long <- ceiling(max(longitud, na.rm = TRUE)) + 0.001
breaks_Longitud <- seq(min_long, max_long, by = 20)
if (max_long > max(breaks_Longitud)) {
breaks_Longitud <- c(breaks_Longitud, max_long)
}
# Crear los rangos
rango_Longitud <- cut(longitud,
breaks = breaks_Longitud,
right = FALSE,
include.lowest = TRUE)
# Tabla de frecuencia
TDF_Longitud <- table(rango_Longitud)
tabla_Longitud <- as.data.frame(TDF_Longitud)
hi_Longitud <- (tabla_Longitud$Freq / sum(tabla_Longitud$Freq)) * 100
tabla_Longitud$hi <- round(hi_Longitud, 2)
Niasc_Longitud <- cumsum(tabla_Longitud$Freq)
Hiasc_Longitud <- cumsum(hi_Longitud)
Nidsc_Longitud <- rev(cumsum(rev(tabla_Longitud$Freq)))
Hidsc_Longitud <- rev(cumsum(rev(hi_Longitud)))
tabla_Longitud_Final <- data.frame(
Rango_Longitud = levels(rango_Longitud),
Frecuencia = tabla_Longitud$Freq,
Porcentaje = tabla_Longitud$hi,
Niasc = Niasc_Longitud,
Hiasc = round(Hiasc_Longitud, 2),
Nidsc = Nidsc_Longitud,
Hidsc = round(Hidsc_Longitud, 2)
)
print(tabla_Longitud_Final)## Rango_Longitud Frecuencia Porcentaje Niasc Hiasc Nidsc Hidsc
## 1 [-174,-154) 5 11.11 5 11.11 45 100.00
## 2 [-154,-134) 3 6.67 8 17.78 40 88.89
## 3 [-134,-114) 4 8.89 12 26.67 37 82.22
## 4 [-114,-94) 4 8.89 16 35.56 33 73.33
## 5 [-94,-74) 16 35.56 32 71.11 29 64.44
## 6 [-74,-54) 8 17.78 40 88.89 13 28.89
## 7 [-54,-34) 0 0.00 40 88.89 5 11.11
## 8 [-34,-14) 0 0.00 40 88.89 5 11.11
## 9 [-14,6) 1 2.22 41 91.11 5 11.11
## 10 [6,26) 1 2.22 42 93.33 4 8.89
## 11 [26,46) 0 0.00 42 93.33 3 6.67
## 12 [46,66) 2 4.44 44 97.78 3 6.67
## 13 [66,86) 0 0.00 44 97.78 1 2.22
## 14 [86,106) 0 0.00 44 97.78 1 2.22
## 15 [106,126) 0 0.00 44 97.78 1 2.22
## 16 [126,146) 0 0.00 44 97.78 1 2.22
## 17 [146,165] 1 2.22 45 100.00 1 2.222.3 Gráficos
2.3.1 Histograma Local
par(mar = c(7, 5, 4, 2))
h <- hist(longitud,
breaks = breaks_Longitud,
freq = TRUE,
main = "Histograma de la Longitud de los Derrames a Nivel Global ",
xlab = "Longitud",
ylab = "Frecuencia",
col = terrain.colors(length(tabla_Longitud_Final$Frecuencia)),
border = "black",
las = 1)## Warning in plot.histogram(r, freq = freq1, col = col, border = border, angle =
## angle, : the AREAS in the plot are wrong -- rather use 'freq = FALSE'
2.3.2 Diagrama de cajas
boxplot(datos$Longuitud,
horizontal = TRUE,
col = "beige",
main = "Diagrama de Caja de la Longitud en Derrames Petroleros a Nivel Global",
cex.main = 0.8,
xlab = "Longitud")
2.3.3 Ojiva ascendente y descendente
x_Longitud <- 1:nrow(tabla_Longitud_Final)
y_ni_asc_Longitud <- tabla_Longitud_Final$Niasc
y_ni_dsc_Longitud <- tabla_Longitud_Final$Nidsc
plot(x_Longitud, y_ni_asc_Longitud,
type = "b",
main = "Ojivas de la Longitud en Derrames Petroleros a Nivel Global",
cex.main = 0.8,
xlab = "Intervalos de Longitud",
ylab = "Frecuencia Acumulada",
col = "black",
pch = 19,
las = 1,
xaxt = "n")
lines(x_Longitud, y_ni_dsc_Longitud, col = "blue", type = "b", pch = 19)
axis(1, at = x_Longitud, labels = tabla_Longitud_Final$Rango_Longuitud, cex.axis = 0.5, las = 2)
grid()
legend("topright",
legend = c("Ascendente", "Descendente"),
col = c("black", "blue"),
lty = 1, pch = 19, cex = 0.7)
2.4 Indicadores estadísticos
#indicadores
# Convertir a numérico y limpiar NA
Longuitud_num <- as.numeric(datos$Longuitud)
Longuitud_num <- Longuitud_num[!is.na(Longuitud_num)]
# Función para calcular la moda
get_mode <- function(v) {
v <- as.numeric(v)
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
# Medidas de tendencia central y dispersión
media <- mean(Longuitud_num)
mediana <- median(Longuitud_num)
moda <- get_mode(Longuitud_num)
desv <- sd(Longuitud_num)
varianza <- var(Longuitud_num)
cv <- (desv / media) * 100
# Medidas de forma
asim <- skewness(Longuitud_num)
curt <- kurtosis(Longuitud_num)
# Tabla de indicadores
indicadores_Respuesta <- data.frame(
Indicador = c("Moda", "Mediana", "Media", "Desviación Estándar",
"Varianza", "Coef. de Variación (%)", "Asimetría", "Curtosis"),
Valor = c(round(moda, 2), round(mediana, 2), round(media, 2), round(desv, 2),
round(varianza, 2), round(cv, 2), round(asim, 2), round(curt, 2))
)
print("Indicadores estadísticos: Longitud en Derrames Petroleros a Nivel Global")## [1] "Indicadores estadísticos: Longitud en Derrames Petroleros a Nivel Global"## Indicador Valor
## Moda -95.00
## Mediana -83.00
## Media -82.84
## Desviación Estándar 61.70
## Varianza 3806.36
## Coef. de Variación (%) -74.47
## Asimetría 1.66
## Curtosis 4.352.5 Conclusión
a mayoría de los derrames de petróleo se concentran entre las longitudes -120° y -60°, correspondientes al hemisferio occidental, especialmente en el océano Atlántico y el continente americano, lo que evidencia una mayor incidencia en estas regiones frente al hemisferio oriental, donde los derrames son escasos.
Este comportamiento queda respaldado por los indicadores estadísticos, ya que la media (-82.84°), la mediana (-83°) y la moda (-95°) confirman la fuerte concentración de eventos en longitudes negativas. Asimismo, la asimetría positiva (1.66) indica la presencia de valores extremos hacia longitudes mayores, mientras que la desviación estándar elevada (61.70) refleja una amplia dispersión longitudinal de los derrames, aunque con clara predominancia en zonas americanas.
3 Maxima Liberación de petróleo
3.1 Extraer la variable
3.2 Rango 1: 0-40000
breaks_1 <- seq(0, 40000, by = 2666.66)
x_rango1 <- Maximo_liberacion_galones[
Maximo_liberacion_galones >= min(breaks_1) &
Maximo_liberacion_galones <= max(breaks_1)
]
# Ajustar último intervalo si hay valores fuera del rango
if (length(x_rango1) > 0 && max(x_rango1) > max(breaks_1)) {
breaks_1[length(breaks_1)] <- max(x_rango1) + 0.01
}
# Agrupar datos en intervalos
cut_1 <- cut(x_rango1, breaks = breaks_1, right = TRUE, include.lowest = TRUE)
# Tabla de frecuencias
TDF_1 <- table(cut_1)
Tabla_1 <- as.data.frame(TDF_1)
# Cálculo de frecuencias y acumulados
hi_1 <- (Tabla_1$Freq / sum(Tabla_1$Freq)) * 100
Ni_asc_1 <- cumsum(Tabla_1$Freq)
Hi_asc_1 <- cumsum(hi_1)
Ni_dsc_1 <- rev(cumsum(rev(Tabla_1$Freq)))
Hi_dsc_1 <- rev(cumsum(rev(hi_1)))
# ETIQUETAS LEGIBLES SIN NOTACIÓN CIENTÍFICA Y SIN ADVERTENCIAS
intervalos_num <- gsub("\\[|\\]|\\(|\\)", "", as.character(Tabla_1$cut_1))
intervalos_partes <- strsplit(intervalos_num, ",")
etiquetas_legibles <- sapply(intervalos_partes, function(x) {
paste0(
format(round(as.numeric(x[1]), 0), big.mark = ",", decimal.mark = ".", scientific = FALSE),
" - ",
format(round(as.numeric(x[2]), 0), big.mark = ",", decimal.mark = ".", scientific = FALSE)
)
})
# Tabla final
Tabla_Final_1 <- data.frame(
Intervalo = etiquetas_legibles,
ni = Tabla_1$Freq,
hi = round(hi_1, 2),
Ni_asc = Ni_asc_1,
Hi_asc = round(Hi_asc_1, 2),
Ni_dsc = Ni_dsc_1,
Hi_dsc = round(Hi_dsc_1, 2),
stringsAsFactors = FALSE
)
# Imprimir tabla
print(Tabla_Final_1)## Intervalo ni hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1 0 - 2,670 1014 60.75 1014 60.75 1669 100.00
## 2 2,670 - 5,330 236 14.14 1250 74.90 655 39.25
## 3 5,330 - 8,000 90 5.39 1340 80.29 419 25.10
## 4 8,000 - 10,700 93 5.57 1433 85.86 329 19.71
## 5 10,700 - 13,300 43 2.58 1476 88.44 236 14.14
## 6 13,300 - 16,000 30 1.80 1506 90.23 193 11.56
## 7 16,000 - 18,700 19 1.14 1525 91.37 163 9.77
## 8 18,700 - 21,300 41 2.46 1566 93.83 144 8.63
## 9 21,300 - 24,000 9 0.54 1575 94.37 103 6.17
## 10 24,000 - 26,700 28 1.68 1603 96.05 94 5.63
## 11 26,700 - 29,300 9 0.54 1612 96.58 66 3.95
## 12 29,300 - 32,000 21 1.26 1633 97.84 57 3.42
## 13 32,000 - 34,700 16 0.96 1649 98.80 36 2.16
## 14 34,700 - 37,300 12 0.72 1661 99.52 20 1.20
## 15 37,300 - 40,000 8 0.48 1669 100.00 8 0.483.2.1 Histograma
par(mar = c(7, 5, 4, 2))
h <- hist(x_rango1,
breaks = breaks_1,
freq = TRUE,
main = "Distribución de la Maxima Liberación Petrolera a Nivel Global (Rango 1)",
xlab = "Máximo de liberación (galones)",
ylab = "Frecuencia",
col = terrain.colors(length(Tabla_Final_1$ni)),
cex.main = 0.4,
border = "black",
las = 1)
3.2.2 Diagrama de caja
boxplot(
Maximo_liberacion_galones[Maximo_liberacion_galones >= 0 & Maximo_liberacion_galones <= 40000],
horizontal = TRUE,
col = "lightblue",
main = "Distribución de la Maxima Liberación Petrolera a Nivel Global(Rango 1)",
xlab = "Máximo de liberación ",
cex.main = 0.4,
xaxt = "n")
axis(1, at = pretty(Maximo_liberacion_galones[Maximo_liberacion_galones >= 0 & Maximo_liberacion_galones <= 50000]),
labels = format(pretty(Maximo_liberacion_galones[Maximo_liberacion_galones >= 0 & Maximo_liberacion_galones <= 50000]),
scientific = FALSE))
3.2.3 Ojiva ascendente y descendente
options(scipen = 999)
x_vals_1 <- seq_along(Tabla_Final_1$Intervalo)
ymax_1 <- max(Tabla_Final_1$Ni_asc, Tabla_Final_1$Ni_dsc) * 1.1
#Convertir los intervalos a etiquetas sin notación científica
intervalos_num <- gsub("\\[|\\]|\\(|\\)|\\s", "", as.character(Tabla_Final_1$Intervalo))
intervalos_partes <- strsplit(intervalos_num, ",")
labels_intervalos <- sapply(intervalos_partes, function(x) {
parte1 <- suppressWarnings(as.numeric(gsub("[^0-9\\.]", "", x[1])))
parte2 <- suppressWarnings(as.numeric(gsub("[^0-9\\.]", "", x[2])))
paste0(
format(parte1, big.mark = " ", decimal.mark = ",", scientific = FALSE, trim = TRUE),
" - ",
format(parte2, big.mark = " ", decimal.mark = ",", scientific = FALSE, trim = TRUE)
)
})
#Ojivas ascendente y descendente
plot(x_vals_1, Tabla_Final_1$Ni_asc,
type = "b", pch = 19, col = "blue",
ylim = c(0, ymax_1),
cex.main = 0.4,
xaxt = "n",
main = "Ojivas Ascendente y Descendente de la Máxima Liberación Petrolera a Nivel Global (Rango 1)",
cex.main = 0.4,
xlab = "Máximo de liberación (galones)",
ylab = "Frecuencia acumulada")
lines(x_vals_1, Tabla_Final_1$Ni_dsc, type = "b", pch = 19, col = "red")
axis(1, at = x_vals_1, labels = labels_intervalos, las = 2, cex.axis = 0.7)
legend("topright", legend = c("Ascendente", "Descendente"),
col = c("blue", "red"), pch = 19)
3.3 Indicadores estadísticos
# Convertir a numérico y limpiar
Max_lib <- as.numeric(datos$Maximo_liberacion_galones)
Max_lib <- Max_lib[!is.na(Max_lib)]
# Filtrar SOLO rango 1: 0 - 40 000
Max_lib_rango1 <- Max_lib[Max_lib >= 0 & Max_lib <= 40000]
# Función para calcular la moda
get_mode <- function(v) {
v <- as.numeric(v)
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
# Medidas de tendencia central y dispersión
media <- mean(Max_lib_rango1)
mediana <- median(Max_lib_rango1)
moda <- get_mode(Max_lib_rango1)
desv <- sd(Max_lib_rango1)
varianza <- var(Max_lib_rango1)
cv <- (desv / media) * 100
# Medidas de forma
asim <- skewness(Max_lib_rango1)
curt <- kurtosis(Max_lib_rango1)
# Tabla de indicadores
indicadores_Rango1 <- data.frame(
Indicador = c("Moda", "Mediana", "Media", "Desviación Estándar",
"Varianza", "Coef. de Variación (%)", "Asimetría", "Curtosis"),
Valor = c(round(moda, 2), round(mediana, 2), round(media, 2), round(desv, 2),
round(varianza, 2), round(cv, 2), round(asim, 2), round(curt, 2))
)
print("Indicadores estadísticos: Máximo de liberación (Rango 1: 0–40 000 galones)")## [1] "Indicadores estadísticos: Máximo de liberación (Rango 1: 0–40 000 galones)"## Indicador Valor
## Moda 1000.00
## Mediana 1470.00
## Media 5032.38
## Desviación Estándar 8058.40
## Varianza 64937830.94
## Coef. de Variación (%) 160.13
## Asimetría 2.32
## Curtosis 5.033.4 RANGO 2: 40001-336000009
# Definir intervalos
breaks_2 <- seq(40001, 336000009, by = 22397333.86)
# Filtrar datos dentro del rango
x_rango2 <- Maximo_liberacion_galones[
Maximo_liberacion_galones >= min(breaks_2) &
Maximo_liberacion_galones <= max(breaks_2)
]
# Ajustar último intervalo si hay valores fuera del rango
if (length(x_rango2) > 0 && max(x_rango2) > max(breaks_2)) {
breaks_2[length(breaks_2)] <- max(x_rango2) + 0.01
}
# Agrupar datos en intervalos
cut_2 <- cut(x_rango2, breaks = breaks_2, right = TRUE, include.lowest = TRUE)
# Tabla de frecuencias
TDF_2 <- table(cut_2)
Tabla_2 <- as.data.frame(TDF_2)
# Cálculo de frecuencias y acumulados
hi_2 <- (Tabla_2$Freq / sum(Tabla_2$Freq)) * 100
Ni_asc_2 <- cumsum(Tabla_2$Freq)
Hi_asc_2 <- cumsum(hi_2)
Ni_dsc_2 <- rev(cumsum(rev(Tabla_2$Freq)))
Hi_dsc_2 <- rev(cumsum(rev(hi_2)))
# ETIQUETAS LEGIBLES SIN NOTACIÓN CIENTÍFICA Y SIN ADVERTENCIAS
intervalos_num <- gsub("\\[|\\]|\\(|\\)", "", as.character(Tabla_2$cut_2))
intervalos_partes <- strsplit(intervalos_num, ",")
etiquetas_legibles <- sapply(intervalos_partes, function(x) {
paste0(
format(round(as.numeric(x[1]), 0), big.mark = ",", decimal.mark = ".", scientific = FALSE),
" - ",
format(round(as.numeric(x[2]), 0), big.mark = ",", decimal.mark = ".", scientific = FALSE)
)
})
# Tabla final
Tabla_Final_2 <- data.frame(
Intervalo = etiquetas_legibles,
ni = Tabla_2$Freq,
hi = round(hi_2, 2),
Ni_asc = Ni_asc_2,
Hi_asc = round(Hi_asc_2, 2),
Ni_dsc = Ni_dsc_2,
Hi_dsc = round(Hi_dsc_2, 2),
stringsAsFactors = FALSE
)
# Imprimir tabla
print(Tabla_Final_2)## Intervalo ni hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1 40,000 - 22,400,000 467 97.29 467 97.29 480 100.00
## 2 22,400,000 - 44,800,000 11 2.29 478 99.58 13 2.71
## 3 44,800,000 - 67,200,000 0 0.00 478 99.58 2 0.42
## 4 67,200,000 - 89,600,000 1 0.21 479 99.79 2 0.42
## 5 89,600,000 - 112,000,000 0 0.00 479 99.79 1 0.21
## 6 112,000,000 - 134,000,000 0 0.00 479 99.79 1 0.21
## 7 134,000,000 - 157,000,000 0 0.00 479 99.79 1 0.21
## 8 157,000,000 - 179,000,000 0 0.00 479 99.79 1 0.21
## 9 179,000,000 - 202,000,000 0 0.00 479 99.79 1 0.21
## 10 202,000,000 - 224,000,000 1 0.21 480 100.00 1 0.21
## 11 224,000,000 - 246,000,000 0 0.00 480 100.00 0 0.00
## 12 246,000,000 - 269,000,000 0 0.00 480 100.00 0 0.00
## 13 269,000,000 - 291,000,000 0 0.00 480 100.00 0 0.00
## 14 291,000,000 - 314,000,000 0 0.00 480 100.00 0 0.00
## 15 314,000,000 - 336,000,000 0 0.00 480 100.00 0 0.003.4.1 Histograma
par(mar = c(10, 5, 4, 2))
h <- hist(
x_rango2,
breaks = breaks_2,
col = "purple",
border = "black",
main = "Distribución de la Máxima Liberación Petrolera a Nivel Global (Rango 2)",
xlab = "Máximo de liberación (galones)",
ylab = "Frecuencia",
cex.main = 0.4,
cex.lab = 0.9,
cex.axis = 0.8,
xaxt = "n"
)
axis(1, at = h$mids, labels = etiquetas_legibles, las = 2, cex.axis = 0.6)
text(h$mids, h$counts, labels = h$counts, pos = 3, cex = 0.7)
3.4.2 Diagrama de caja
boxplot(
Maximo_liberacion_galones[
Maximo_liberacion_galones >= 40001 & Maximo_liberacion_galones <= 336000009
],
horizontal = TRUE,
col = "purple3",
main = "Distribución de la Maxima Liberación Petrolera a Nivel Global (Rango 2)",
xlab = "Maximo de liberación",
cex.main = 0.95)
3.4.3 Ojiva ascendente y descendente
x_vals_2 <- seq_along(Tabla_Final_2$Intervalo)
ymax_2 <- max(Tabla_Final_2$Ni_asc, Tabla_Final_2$Ni_dsc) * 1.1
plot(x_vals_2, Tabla_Final_2$Ni_asc,
type = "b", pch = 19, col = "blue",
ylim = c(0, ymax_2),
xaxt = "n",
main = "Ojiva ascendente (Rango 2)",
xlab = "Maximo de liberación", ylab = "Frecuencia acumulada")
axis(1, at = x_vals_2, labels = Tabla_Final_2$Intervalo, las = 2, cex.main = 0.4, cex.axis = 0.7)
plot(x_vals_2, Tabla_Final_2$Ni_dsc,
type = "b", pch = 19, col = "red",
ylim = c(0, ymax_2),
xaxt = "n",
main = "Ojiva descendente (Rango 2)",
xlab = "Maximo de liberación", ylab = "Frecuencia acumulada")
axis(1, at = x_vals_2, labels = Tabla_Final_2$Intervalo, las = 2, cex.axis = 0.7)
plot(x_vals_2, Tabla_Final_2$Ni_asc,
type = "b", pch = 19, col = "blue",
ylim = c(0, ymax_2),
xaxt = "n",
main = "Ojivas Ascendente y Descendente (Rango 2)",
xlab = "Maximo de liberación", ylab = "Frecuencia acumulada")
lines(x_vals_2, Tabla_Final_2$Ni_dsc, type = "b", pch = 19, col = "red")
axis(1, at = x_vals_2, labels = Tabla_Final_2$Intervalo, las = 2, cex.axis = 0.7, cex.main = 0.4)
legend("topright", legend = c("Ascendente", "Descendente"), col = c("blue", "red"), pch = 19)
3.4.4 Indicadores estadísticos
library(e1071)
# Convertir a numérico y limpiar
Max_lib <- as.numeric(datos$Maximo_liberacion_galones)
Max_lib <- Max_lib[!is.na(Max_lib)]
Max_lib_rango2 <- Max_lib[Max_lib >= 40001 & Max_lib <= 336000009]
# Función para calcular la moda
get_mode <- function(v) {
v <- as.numeric(v)
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
# Medidas de tendencia central y dispersión
media <- mean(Max_lib_rango2)
mediana <- median(Max_lib_rango2)
moda <- get_mode(Max_lib_rango2)
desv <- sd(Max_lib_rango2)
varianza <- var(Max_lib_rango2)
cv <- (desv / media) * 100
# Medidas de forma
asim <- skewness(Max_lib_rango2)
curt <- kurtosis(Max_lib_rango2)
# Tabla de indicadores
indicadores_Rango2 <- data.frame(
Indicador = c("Moda", "Mediana", "Media", "Desviación Estándar",
"Varianza", "Coef. de Variación (%)", "Asimetría", "Curtosis"),
Valor = c(round(moda, 2), round(mediana, 2), round(media, 2),
round(desv, 2), round(varianza, 2), round(cv, 2),
round(asim, 2), round(curt, 2))
)
print("Indicadores estadísticos: Máximo de liberación (Rango 2: 40 001 – 336 000 009 galones)")## [1] "Indicadores estadísticos: Máximo de liberación (Rango 2: 40 001 – 336 000 009 galones)"## Indicador Valor
## Moda 42000.00
## Mediana 287000.00
## Media 3541669.38
## Desviación Estándar 18887799.46
## Varianza 356748968581849.56
## Coef. de Variación (%) 533.30
## Asimetría 14.03
## Curtosis 223.893.5 Conclusión
El análisis de la Máxima Liberación Petrolera a Nivel Global muestra diferencias significativas entre los dos rangos evaluados.
En el Rango 1 (0 – 40 000 galones), la distribución presenta una media de 5 032 galones y una mediana de 1 470 galones, lo que indica que la mayoría de los derrames son de baja magnitud. La desviación estándar de 8 058 galones señala una dispersión moderada, mientras que la asimetría positiva (2.32) evidencia la presencia de algunos derrames mayores que sesgan la distribución hacia la derecha.
En el Rango 2 (40 001 – 336 000 009 galones), los valores aumentan drásticamente, con una media de 3 541 669 galones y una mediana de 287 000 galones, reflejando la influencia de derrames extremadamente grandes. La elevada desviación estándar (18 887 799 galones) confirma una variabilidad muy alta, y la asimetría positiva extrema (14.03) indica una fuerte concentración en pocos eventos de gran magnitud.
En conclusión, el Rango 1 agrupa derrames pequeños y frecuentes, mientras que el Rango 2 contiene eventos excepcionales de gran impacto ambiental, los cuales dominan la variabilidad global de la liberación de petróleo.
4 Respuesta actual
4.1 Extraer la variable
## Warning: NAs introduced by coercion4.2 Rango 1: 0 - 10000
breaks_1 <- seq(0, 10000, by = 500)
x_rango1 <- Respuesta_actual_galones[
Respuesta_actual_galones >= min(breaks_1) &
Respuesta_actual_galones <= max(breaks_1)
]
if (length(x_rango1) > 0 && max(x_rango1) > max(breaks_1)) {
breaks_1[length(breaks_1)] <- max(x_rango1) + 0.01
}
cut_1 <- cut(x_rango1, breaks = breaks_1, right = TRUE, include.lowest = TRUE)
TDF_1 <- table(cut_1)
Tabla_1 <- as.data.frame(TDF_1)
hi_1 <- (Tabla_1$Freq / sum(Tabla_1$Freq)) * 100
Ni_asc_1 <- cumsum(Tabla_1$Freq)
Hi_asc_1 <- cumsum(hi_1)
Ni_dsc_1 <- rev(cumsum(rev(Tabla_1$Freq)))
Hi_dsc_1 <- rev(cumsum(rev(hi_1)))
# Etiquetas legibles (sin notación científica)
intervalos_num <- gsub("\\[|\\]|\\(|\\)", "", as.character(Tabla_1$cut_1))
intervalos_partes <- strsplit(intervalos_num, ",")
etiquetas_legibles <- sapply(intervalos_partes, function(x) {
paste0(round(as.numeric(x[1])), " - ", round(as.numeric(x[2])))
})
Tabla_Final_1 <- data.frame(
Intervalo = etiquetas_legibles,
ni = Tabla_1$Freq,
hi = round(hi_1, 2),
Ni_asc = Ni_asc_1,
Hi_asc = round(Hi_asc_1, 2),
Ni_dsc = Ni_dsc_1,
Hi_dsc = round(Hi_dsc_1, 2),
stringsAsFactors = FALSE
)
print(Tabla_Final_1)## Intervalo ni hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1 0 - 500 778 57.50 778 57.50 1353 100.00
## 2 500 - 1000 146 10.79 924 68.29 575 42.50
## 3 1000 - 1500 53 3.92 977 72.21 429 31.71
## 4 1500 - 2000 65 4.80 1042 77.01 376 27.79
## 5 2000 - 2500 44 3.25 1086 80.27 311 22.99
## 6 2500 - 3000 44 3.25 1130 83.52 267 19.73
## 7 3000 - 3500 17 1.26 1147 84.77 223 16.48
## 8 3500 - 4000 28 2.07 1175 86.84 206 15.23
## 9 4000 - 4500 42 3.10 1217 89.95 178 13.16
## 10 4500 - 5000 34 2.51 1251 92.46 136 10.05
## 11 5000 - 5500 4 0.30 1255 92.76 102 7.54
## 12 5500 - 6000 11 0.81 1266 93.57 98 7.24
## 13 6000 - 6500 5 0.37 1271 93.94 87 6.43
## 14 6500 - 7000 17 1.26 1288 95.20 82 6.06
## 15 7000 - 7500 2 0.15 1290 95.34 65 4.80
## 16 7500 - 8000 11 0.81 1301 96.16 63 4.66
## 17 8000 - 8500 19 1.40 1320 97.56 52 3.84
## 18 8500 - 9000 8 0.59 1328 98.15 33 2.44
## 19 9000 - 9500 3 0.22 1331 98.37 25 1.85
## 20 9500 - 10000 22 1.63 1353 100.00 22 1.634.2.1 Histograma
par(mar = c(9, 5, 4, 2)) # Márgenes amplios
# Crear histograma
hist(
x_rango1,
breaks = breaks_1,
col = "purple2",
border = "black",
main = "Distribución de la Cantidad Recolectada de Derrames a Nivel Global (Rango 1)",
xlab = "Cantidad recolectada (galones)",
ylab = "Frecuencia",
ylim = c(0, max(Tabla_1$Freq) + 5),
cex.main = 0.4,
cex.lab = 0.9,
cex.axis = 0.8
)
h <- hist(x_rango1, breaks = breaks_1, plot = FALSE)
text(h$mids, h$counts, labels = h$counts, pos = 3, cex = 0.7)
4.2.2 Diagrama de caja
boxplot(
Respuesta_actual_galones[Respuesta_actual_galones >= 0 & Respuesta_actual_galones <= 10000],
horizontal = TRUE,
col = "purple2",
main = "Distribución de la Cantidad recolectada de los derrames a Nivel Global (Rango 1)",
xlab = "Cantidad Recolectada",
cex.main = 0.95,
xaxt = "n")
axis(1, at = pretty(Respuesta_actual_galones[Respuesta_actual_galones >= 0 & Respuesta_actual_galones <= 500000]),
labels = format(pretty(Respuesta_actual_galones[Respuesta_actual_galones >= 0 & Respuesta_actual_galones <= 500000]),
scientific = FALSE))
4.2.3 Ojiva ascendente y descendente
x_vals_1 <- seq_along(Tabla_Final_1$Intervalo)
ymax_1 <- max(Tabla_Final_1$Ni_asc) * 1.1
plot(x_vals_1, Tabla_Final_1$Ni_asc,
type = "b", pch = 19, col = "blue", lwd = 2,
ylim = c(0, ymax_1),
xaxt = "n",
main = "Ojiva ascendente (Rango 1)",
xlab = "Cantidad Recolectada", ylab = "Frecuencia acumulada")
axis(1, at = x_vals_1, labels = Tabla_Final_1$Intervalo, las = 2, cex.axis = 0.7)
plot(x_vals_1, Tabla_Final_1$Ni_dsc,
type = "b", pch = 19, col = "red", lwd = 2,
ylim = c(0, ymax_1),
xaxt = "n",
main = "Ojiva descendente (Rango 1)",
xlab = "Cantidad Recolectada", ylab = "Frecuencia acumulada")
axis(1, at = x_vals_1, labels = Tabla_Final_1$Intervalo, las = 2, cex.axis = 0.7)
plot(x_vals_1, Tabla_Final_1$Ni_asc,
type = "b", pch = 19, col = "blue", lwd = 2,
ylim = c(0, ymax_1),
xaxt = "n",
main = "Ojivas Ascendente y Descendente de la Cantidad recolectada de los derrames a Nivel Global (Rango 1)",
xlab = "Cantidad Recolectada", ylab = "Frecuencia acumulada")
lines(x_vals_1, Tabla_Final_1$Ni_dsc, col = "red", lwd = 2, type = "b", pch = 19)
axis(1, at = x_vals_1, labels = Tabla_Final_1$Intervalo, las = 2, cex.axis = 0.7)
legend("topright",
legend = c("Ascendente", "Descendente"),
col = c("blue", "red"),
lty = 1, pch = 19, lwd = 2,
cex = 0.7)
4.3 Indicadores Estadísticos
library(e1071)
# Convertir a numérico y limpiar
Resp_actual <- as.numeric(datos$Respuesta_actual_galones)## Warning: NAs introduced by coercionResp_actual <- Resp_actual[!is.na(Resp_actual)]
# Filtrar SOLO rango 1: 0 - 40000
Resp_actual_rango1 <- Resp_actual[Resp_actual >= 0 & Resp_actual <= 40000]
# Función para calcular la moda
get_mode <- function(v) {
v <- as.numeric(v)
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
# Medidas de tendencia central y dispersión
media <- mean(Resp_actual_rango1)
mediana <- median(Resp_actual_rango1)
moda <- get_mode(Resp_actual_rango1)
desv <- sd(Resp_actual_rango1)
varianza <- var(Resp_actual_rango1)
cv <- (desv / media) * 100
# Medidas de forma
asim <- skewness(Resp_actual_rango1)
curt <- kurtosis(Resp_actual_rango1)
# Tabla de indicadores
indicadores_Rango1_actual <- data.frame(
Indicador = c("Moda", "Mediana", "Media", "Desviación Estándar",
"Varianza", "Coef. de Variación (%)", "Asimetría", "Curtosis"),
Valor = c(round(moda, 2), round(mediana, 2), round(media, 2),
round(desv, 2), round(varianza, 2), round(cv, 2),
round(asim, 2), round(curt, 2))
)
print("Indicadores estadísticos: Respuesta actual (Rango 1: 0 – 40 000 galones)")## [1] "Indicadores estadísticos: Respuesta actual (Rango 1: 0 – 40 000 galones)"## Indicador Valor
## Moda 0.00
## Mediana 500.00
## Media 3599.25
## Desviación Estándar 7195.78
## Varianza 51779178.24
## Coef. de Variación (%) 199.92
## Asimetría 2.87
## Curtosis 8.314.4 Rango 2: 10001 - 336000000
breaks_2 <- seq(10001, 600000000, by = 29999500)
x_rango2 <- Respuesta_actual_galones[
Respuesta_actual_galones >= min(breaks_2) &
Respuesta_actual_galones <= max(breaks_2)
]
# Ajustar último límite si es necesario
if (length(x_rango2) > 0 && max(x_rango2) > max(breaks_2)) {
breaks_2[length(breaks_2)] <- max(x_rango2) + 0.01
}
cut_2 <- cut(x_rango2, breaks = breaks_2, right = TRUE, include.lowest = TRUE)
TDF_2 <- table(cut_2)
Tabla_2 <- as.data.frame(TDF_2)
# Cálculos de frecuencias
hi_2 <- (Tabla_2$Freq / sum(Tabla_2$Freq)) * 100
Ni_asc_2 <- cumsum(Tabla_2$Freq)
Hi_asc_2 <- cumsum(hi_2)
Ni_dsc_2 <- rev(cumsum(rev(Tabla_2$Freq)))
Hi_dsc_2 <- rev(cumsum(rev(hi_2)))
# Etiquetas sin notación científica
intervalos_num_2 <- gsub("\\[|\\]|\\(|\\)", "", as.character(Tabla_2$cut_2))
intervalos_partes_2 <- strsplit(intervalos_num_2, ",")
etiquetas_legibles_2 <- sapply(intervalos_partes_2, function(x) {
paste0(format(round(as.numeric(x[1])), scientific = FALSE),
" - ",
format(round(as.numeric(x[2])), scientific = FALSE))
})
# Tabla final
Tabla_Final_2 <- data.frame(
Intervalo = etiquetas_legibles_2,
ni = Tabla_2$Freq,
hi = round(hi_2, 2),
Ni_asc = Ni_asc_2,
Hi_asc = round(Hi_asc_2, 2),
Ni_dsc = Ni_dsc_2,
Hi_dsc = round(Hi_dsc_2, 2),
stringsAsFactors = FALSE
)
print(Tabla_Final_2)## Intervalo ni hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1 10000 - 30000000 431 97.95 431 97.95 440 100.00
## 2 30000000 - 60000000 5 1.14 436 99.09 9 2.05
## 3 60000000 - 90000000 1 0.23 437 99.32 4 0.91
## 4 90000000 - 120000000 0 0.00 437 99.32 3 0.68
## 5 120000000 - 150000000 0 0.00 437 99.32 3 0.68
## 6 150000000 - 180000000 1 0.23 438 99.55 3 0.68
## 7 180000000 - 210000000 0 0.00 438 99.55 2 0.45
## 8 210000000 - 240000000 0 0.00 438 99.55 2 0.45
## 9 240000000 - 270000000 1 0.23 439 99.77 2 0.45
## 10 270000000 - 300000000 0 0.00 439 99.77 1 0.23
## 11 300000000 - 330000000 0 0.00 439 99.77 1 0.23
## 12 330000000 - 360000000 1 0.23 440 100.00 1 0.23
## 13 360000000 - 390000000 0 0.00 440 100.00 0 0.00
## 14 390000000 - 420000000 0 0.00 440 100.00 0 0.00
## 15 420000000 - 450000000 0 0.00 440 100.00 0 0.00
## 16 450000000 - 480000000 0 0.00 440 100.00 0 0.00
## 17 480000000 - 510000000 0 0.00 440 100.00 0 0.00
## 18 510000000 - 540000000 0 0.00 440 100.00 0 0.00
## 19 540000000 - 570000000 0 0.00 440 100.00 0 0.004.4.1 Histograma
par(mar = c(9, 5, 4, 2)) # Márgenes amplios
hist(
x_rango2,
breaks = breaks_2,
col = "steelblue3",
border = "black",
main = "Distribución de la Cantidad Recolectada de Derrames a Nivel Global (Rango 2)",
xlab = "Cantidad recolectada (galones)",
ylab = "Frecuencia",
ylim = c(0, max(Tabla_2$Freq) + 5),
cex.main = 0.8,
cex.lab = 0.9,
cex.axis = 0.8,
xaxt = "n"
)
# Eje X sin notación científica
axis(1,
at = pretty(breaks_2),
labels = format(pretty(breaks_2), scientific = FALSE),
las = 2, cex.axis = 0.6)
h2 <- hist(x_rango2, breaks = breaks_2, plot = FALSE)
text(h2$mids, h2$counts, labels = h2$counts, pos = 3, cex = 0.7)
4.4.2 Diagrama de caja
boxplot(
Respuesta_actual_galones[Respuesta_actual_galones >= 10001 & Respuesta_actual_galones <= 600000000],
horizontal = TRUE,
col = "steelblue3",
main = "Distribución de la Cantidad Recolectada de los Derrames a Nivel Global (Rango 2)",
xlab = "Cantidad Recolectada (galones)",
cex.main = 0.9,
xaxt = "n"
)
axis(1,
at = pretty(breaks_2),
labels = format(pretty(breaks_2), scientific = FALSE),
las = 2, cex.axis = 0.6)
4.4.3 Ojiva ascendente y descendente
x_vals_2 <- seq_along(Tabla_Final_2$Intervalo)
ymax_2 <- max(Tabla_Final_2$Ni_asc, Tabla_Final_2$Ni_dsc) * 1.1
# Crear etiquetas sin notación científica
intervalos_2 <- gsub("\\[|\\]|\\(|\\)", "", as.character(Tabla_2$cut_2))
intervalos_partes_2 <- strsplit(intervalos_2, ",")
# Crear etiquetas con espacio como separador de miles
labels_intervalos_2 <- sapply(intervalos_partes_2, function(x) {
paste0(
format(as.numeric(x[1]), big.mark = " ", decimal.mark = ",", scientific = FALSE),
" - ",
format(as.numeric(x[2]), big.mark = " ", decimal.mark = ",", scientific = FALSE)
)
})
# Graficar ambas ojivas
plot(x_vals_2, Tabla_Final_2$Ni_asc,
type = "b", pch = 19, col = "blue",
ylim = c(0, ymax_2),
xaxt = "n",
main = "Ojivas Ascendente y Descendente de la Cantidad Recolectada (Rango 2)",
cex.main = 0.9,
xlab = "Cantidad recolectada (galones)",
ylab = "Frecuencia acumulada")
lines(x_vals_2, Tabla_Final_2$Ni_dsc, type = "b", pch = 19, col = "red")
axis(1, at = x_vals_2, labels = labels_intervalos_2, las = 2, cex.axis = 0.6)
legend("topright", legend = c("Ascendente", "Descendente"),
col = c("blue", "red"), pch = 19)
4.5 Indicadores Estadisticos
library(e1071)
# Convertir a numérico y limpiar
Resp_actual <- as.numeric(datos$Respuesta_actual_galones)## Warning: NAs introduced by coercionResp_actual <- Resp_actual[!is.na(Resp_actual)]
Resp_actual_rango2 <- Resp_actual[Resp_actual >= 10001 & Resp_actual <= 6000000000]
# Función para calcular la moda
get_mode <- function(v) {
v <- as.numeric(v)
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
# Medidas de tendencia central y dispersión
media <- mean(Resp_actual_rango2)
mediana <- median(Resp_actual_rango2)
moda <- get_mode(Resp_actual_rango2)
desv <- sd(Resp_actual_rango2)
varianza <- var(Resp_actual_rango2)
cv <- (desv / media) * 100
# Medidas de forma
asim <- skewness(Resp_actual_rango2)
curt <- kurtosis(Resp_actual_rango2)
# Tabla de indicadores
indicadores_Rango2_actual <- data.frame(
Indicador = c("Moda", "Mediana", "Media", "Desviación Estándar",
"Varianza", "Coef. de Variación (%)", "Asimetría", "Curtosis"),
Valor = c(round(moda, 2), round(mediana, 2), round(media, 2),
round(desv, 2), round(varianza, 2), round(cv, 2),
round(asim, 2), round(curt, 2))
)
print("Indicadores estadísticos: Respuesta actual (Rango 2: 40 001 – 336 000 009 galones)")## [1] "Indicadores estadísticos: Respuesta actual (Rango 2: 40 001 – 336 000 009 galones)"## Indicador Valor
## Moda 42000.00
## Mediana 84000.00
## Media 3057715.22
## Desviación Estándar 22059869.08
## Varianza 486637824022338.38
## Coef. de Variación (%) 721.45
## Asimetría 12.12
## Curtosis 159.114.6 Conclusión
El análisis de la variable Cantidad recolectada de los derrames a nivel global evidencia diferencias claras entre los dos rangos evaluados.
En el Rango 1, la distribución se concentra en valores bajos, con una media de 3 599 galones y una mediana de 500 galones, lo que indica que la mayoría de los eventos involucran volúmenes reducidos de recolección. La desviación estándar de 7 196 galones refleja una dispersión moderada, mientras que la asimetría positiva (2.87) evidencia la presencia de algunos valores altos que sesgan la distribución hacia la derecha.
En contraste, el Rango 2 presenta una fuerte variabilidad, reflejada en una media de 3 057 715 galones y una mediana de 84 000 galones, mostrando la influencia de pocos eventos extremadamente grandes. La desviación estándar de 22 059 869 galones confirma una dispersión muy alta, y la asimetría positiva de 12.12 indica que la distribución está fuertemente sesgada por casos excepcionales.
En conclusión, el Rango 1 agrupa eventos frecuentes y de baja magnitud, mientras que el Rango 2 contiene casos poco frecuentes pero de alto impacto, los cuales dominan el comportamiento estadístico de la cantidad recolectada.