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.4 Conclusión
La mayoría de los derrames se concentran entre las latitudes 10° y 40°, principalmente en el hemisferio norte, lo que refleja una mayor actividad petrolera en zonas tropicales y subtropicales. En las latitudes altas, los derrames son poco frecuentes.
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 Conclusión
La mayoría de los derrames se concentran entre las longitudes -120° y -60°, correspondientes al hemisferio occidental, especialmente en zonas del océano Atlántico y América. En cambio, en el hemisferio oriental los derrames son escasos, lo que indica una mayor incidencia en regiones americanas y menor actividad en Asia y Oceanía.
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)
text(h$mids,
h$counts,
labels = h$counts,
pos = 3,
cex = 0.8,
col = "black")
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 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.3.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.3.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.3.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 Conclusión
La variable que nos indica la Maxima Liberación Petrolera a Nivel Global nos muestra que en el Rango 1, la distribución se concentra en valores bajos y presenta pocos valores atípicos, mostrando una menor dispersión y una forma más homogénea. En cambio, el Rango 2 evidencia una mayor variabilidad y una gran cantidad de outliers, con algunos valores extremadamente altos que generan una distribución más sesgada y dispersa. Esto indica que los eventos del Rango 1 son más frecuentes y estables, mientras que en el Rango 2 predominan casos excepcionales de gran magnitud.
4 Volumen derramado
4.1 Extraer la variable
## Warning: NAs introduced by coercion4.2 Rango 1: 0 - 10000
breaks_1 <- seq(0, 10000, by = 500)
x_rango1 <- Volumen_derramados_galones[
Volumen_derramados_galones >= min(breaks_1) &
Volumen_derramados_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)
# Tabla de frecuencias
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)))
# Crear etiquetas legibles SIN notación científica
# Se extraen los valores numéricos de los intervalos
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 1056 58.70 1056 58.70 1799 100.00
## 2 500 - 1000 209 11.62 1265 70.32 743 41.30
## 3 1000 - 1500 67 3.72 1332 74.04 534 29.68
## 4 1500 - 2000 79 4.39 1411 78.43 467 25.96
## 5 2000 - 2500 53 2.95 1464 81.38 388 21.57
## 6 2500 - 3000 38 2.11 1502 83.49 335 18.62
## 7 3000 - 3500 34 1.89 1536 85.38 297 16.51
## 8 3500 - 4000 38 2.11 1574 87.49 263 14.62
## 9 4000 - 4500 25 1.39 1599 88.88 225 12.51
## 10 4500 - 5000 50 2.78 1649 91.66 200 11.12
## 11 5000 - 5500 10 0.56 1659 92.22 150 8.34
## 12 5500 - 6000 30 1.67 1689 93.89 140 7.78
## 13 6000 - 6500 16 0.89 1705 94.77 110 6.11
## 14 6500 - 7000 23 1.28 1728 96.05 94 5.23
## 15 7000 - 7500 7 0.39 1735 96.44 71 3.95
## 16 7500 - 8000 9 0.50 1744 96.94 64 3.56
## 17 8000 - 8500 19 1.06 1763 98.00 55 3.06
## 18 8500 - 9000 13 0.72 1776 98.72 36 2.00
## 19 9000 - 9500 2 0.11 1778 98.83 23 1.28
## 20 9500 - 10000 21 1.17 1799 100.00 21 1.174.2.1 Histograma
par(mar = c(9, 5, 4, 2))
hist(
x_rango1,
breaks = breaks_1,
col = "aquamarine",
border = "black",
main = "Distribución del Volumen Derramado a Nivel Global (Rango 1)",
xlab = "Volumen Derramado (galones)",
ylab = "Frecuencia",
ylim = c(0, 800),
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(
Volumen_derramados_galones[Volumen_derramados_galones >= 0 & Volumen_derramados_galones <= 10000],
horizontal = TRUE,
col = "aquamarine2",
main = "Distribución de Volumen Derramado a Nivel Global (Rango 1)",
cex.main = 0.4,
xlab = "Volumen Derramado",
cex.main = 0.95,
xaxt = "n")## Warning in (function (z, notch = FALSE, width = NULL, varwidth = FALSE, :
## Duplicated argument cex.main = 0.95 is disregarded axis(1, at = pretty(Volumen_derramados_galones[Volumen_derramados_galones >= 0 & Volumen_derramados_galones <= 10000]),
labels = format(pretty(Volumen_derramados_galones[Volumen_derramados_galones >= 0 & Volumen_derramados_galones <= 10000]),
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 = "Volumen Derramado", 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 = "Volumen Derramado", 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 del Volumen Derramado a Nivel Global (Rango 1)",
cex.main = 0.4,
xlab = "Volumen Derramado", 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.5)
legend("topright",
legend = c("Ascendente", "Descendente"),
col = c("blue", "red"),
lty = 1, pch = 19, lwd = 2,
cex = 0.7)
4.3 Rango 2: 10001 - 600000000
breaks_2 <- seq(10001, 6000000000, by = 299995000)
x_rango2 <- Volumen_derramados_galones[
Volumen_derramados_galones >= min(breaks_2) &
Volumen_derramados_galones <= max(breaks_2)
]
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)
# Tabla de frecuencias
TDF_2 <- table(cut_2)
Tabla_2 <- as.data.frame(TDF_2)
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)))
# Crear etiquetas legibles SIN notación científica
intervalos_num <- gsub("\\[|\\]|\\(|\\)", "", as.character(Tabla_2$cut_2))
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_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
)
print(Tabla_Final_2)## Intervalo ni hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1 10000 - 300000000 305 100 305 100 305 100
## 2 300000000 - 600000000 0 0 305 100 0 0
## 3 600000000 - 900000000 0 0 305 100 0 0
## 4 900000000 - 1200000000 0 0 305 100 0 0
## 5 1200000000 - 1500000000 0 0 305 100 0 0
## 6 1500000000 - 1800000000 0 0 305 100 0 0
## 7 1800000000 - 2100000000 0 0 305 100 0 0
## 8 2100000000 - 2400000000 0 0 305 100 0 0
## 9 2400000000 - 2700000000 0 0 305 100 0 0
## 10 2700000000 - 3000000000 0 0 305 100 0 0
## 11 3000000000 - 3300000000 0 0 305 100 0 0
## 12 3300000000 - 3600000000 0 0 305 100 0 0
## 13 3600000000 - 3900000000 0 0 305 100 0 0
## 14 3900000000 - 4200000000 0 0 305 100 0 0
## 15 4200000000 - 4500000000 0 0 305 100 0 0
## 16 4500000000 - 4800000000 0 0 305 100 0 0
## 17 4800000000 - 5100000000 0 0 305 100 0 0
## 18 5100000000 - 5400000000 0 0 305 100 0 0
## 19 5400000000 - 5700000000 0 0 305 100 0 0
## 20 5700000000 - 6000000000 0 0 305 100 0 04.3.1 Histograma
options(scipen = 999)
par(mar = c(10, 5, 4, 2))
hist(
x_rango2,
breaks = breaks_2,
col = "skyblue",
border = "black",
main = "Distribución del Volumen Derramado a Nivel Global (Rango 2)",
xlab = "Volumen Derramado (galones)",
ylab = "Frecuencia",
ylim = c(0, 450),
cex.main = 0.4,
cex.lab = 0.9,
cex.axis = 0.8
)
h <- hist(x_rango2, breaks = breaks_2, plot = FALSE)
text(h$mids, h$counts, labels = h$counts, pos = 3, cex = 0.7)
4.3.2 Diagrama de caja
boxplot(
x_rango2,
horizontal = TRUE,
col = "skyblue2",
main = "Distribución de Volumen Derramado a Nivel Global (Rango 2)",
cex.main = 0.4,
xlab = "Volumen Derramado",
cex.main = 0.95,
xaxt = "n"
)## Warning in (function (z, notch = FALSE, width = NULL, varwidth = FALSE, :
## Duplicated argument cex.main = 0.95 is disregarded
4.3.3 Ojiva ascendente y descendente
# Valores del eje x (índices de los intervalos)
x_vals_2 <- seq_along(Tabla_Final_2$Intervalo)
# Límite superior del eje y
ymax_2 <- max(Tabla_Final_2$Ni_asc, Tabla_Final_2$Ni_dsc) * 1.1
# ---- OJIVA ASCENDENTE ----
plot(x_vals_2, Tabla_Final_2$Ni_asc,
type = "b", pch = 19, col = "blue", lwd = 2,
ylim = c(0, ymax_2),
xaxt = "n",
main = "Ojiva Ascendente (Rango 2)",
xlab = "Volumen Derramado",
ylab = "Frecuencia acumulada")
axis(1, at = x_vals_2, labels = Tabla_Final_2$Intervalo, las = 2, cex.axis = 0.8)
# ---- OJIVA DESCENDENTE ----
plot(x_vals_2, Tabla_Final_2$Ni_dsc,
type = "b", pch = 19, col = "red", lwd = 2,
ylim = c(0, ymax_2),
xaxt = "n",
main = "Ojiva Descendente (Rango 2)",
xlab = "Volumen Derramado",
ylab = "Frecuencia acumulada")
axis(1, at = x_vals_2, labels = Tabla_Final_2$Intervalo, las = 2, cex.axis = 0.8)
# ---- OJIVA COMBINADA (ASC + DESC) ----
plot(x_vals_2, Tabla_Final_2$Ni_asc,
type = "b", pch = 19, col = "blue", lwd = 2,
ylim = c(0, ymax_2),
xaxt = "n",
main = "Ojivas Ascendente y Descendente del Volumen Derramado a Nivel Global (Rango 2)",
xlab = "Volumen Derramado",
ylab = "Frecuencia acumulada")
# Agregar la línea descendente
lines(x_vals_2, Tabla_Final_2$Ni_dsc, col = "red", lwd = 2, type = "b", pch = 19)
# Eje x y leyenda final (centrada y proporcionada)
axis(1, at = x_vals_2, labels = Tabla_Final_2$Intervalo, las = 2, cex.axis = 0.8)
legend("topright",
legend = c("Ascendente", "Descendente"),
col = c("blue", "red"),
lty = 1, pch = 19, lwd = 2,
cex = 0.8,
bg = "white")
4.4 Conclusión
La variable que nos indica la Cantidadde volumen derramado a Nivel Global nos muestra que en el Rango 1, la distribución se concentra en valores bajos y presenta pocos valores atípicos, mostrando una menor dispersión y una forma más homogénea. En cambio, el Rango 2 evidencia una mayor variabilidad y una gran cantidad de outliers, con algunos valores extremadamente altos que generan una distribución más sesgada y dispersa. Esto indica que los eventos del Rango 1 son más frecuentes y estables, mientras que en el Rango 2 predominan casos excepcionales de gran magnitud.
5 Respuesta actual
5.1 Extraer la variable
## Warning: NAs introduced by coercion5.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.635.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)
5.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))
5.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)
5.3 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.005.3.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)
5.3.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)
5.3.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)
5.4 Conclusión
La variable que nos indica la Cantidad recolectada de los derrames a Nivel Global nos muestra que en el Rango 1, la distribución se concentra en valores bajos y presenta pocos valores atípicos, mostrando una menor dispersión y una forma más homogénea. En cambio, el Rango 2 evidencia una mayor variabilidad y una gran cantidad de outliers, con algunos valores extremadamente altos que generan una distribución más sesgada y dispersa. Esto indica que los eventos del Rango 1 son más frecuentes y estables, mientras que en el Rango 2 predominan casos excepcionales de gran magnitud.