1 Latitud

1.1 Carga de datos

datos <- read.csv("Derrames_globales2.csv", header = TRUE, sep = ";" , dec = ".")
str(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

datos$Latitud <- as.numeric(as.character(datos$Latitud))
## Warning: NAs introduced by coercion
latitud <- na.omit(datos$Latitud)

1.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.14

1.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'
text(h$mids,
     h$counts,
     labels = h$counts,
     pos = 3,
     cex = 0.8,
     col = "black")

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

datos$Longuitud <- as.numeric(as.character(datos$Longuitud))
## Warning: NAs introduced by coercion
longitud <- na.omit(datos$Longuitud)

2.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.22

2.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'
text(h$mids,
     h$counts,
     labels = h$counts,
     pos = 3,
     cex = 0.8,
     col = "black")

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

datos$Maximo_liberacion_galones <- as.numeric(as.character(datos$Maximo_liberacion_galones))
Maximo_liberacion_galones <- na.omit(datos$Maximo_liberacion_galones)

3.2 Rango 1: 0-40000

breaks_1 <- seq(0, 40000, by = 2666.66)
rango1 <- Maximo_liberacion_galones[
  Maximo_liberacion_galones >= min(breaks_1) &
    Maximo_liberacion_galones <= max(breaks_1)
]
if (max(rango1) > max(breaks_1)) {
  breaks_1[length(breaks_1)] <- max(rango1) + 0.01
}
rango_1 <- cut(rango1,
               breaks = breaks_1,
               right = TRUE,
               include.lowest = TRUE)
TDF_1 <- table(rango_1)
Tabla_1 <- as.data.frame(TDF_1)
hi_1 <- (Tabla_1$Freq / sum(Tabla_1$Freq)) * 100
Tabla_1$hi <- round(hi_1, 2)
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)))
Tabla_Final_1 <- data.frame(
  Intervalo = levels(rango_1),
  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)
)
print(Tabla_Final_1)
##              Intervalo   ni    hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1         [0,2.67e+03] 1014 60.75   1014  60.75   1669 100.00
## 2  (2.67e+03,5.33e+03]  236 14.14   1250  74.90    655  39.25
## 3     (5.33e+03,8e+03]   90  5.39   1340  80.29    419  25.10
## 4     (8e+03,1.07e+04]   93  5.57   1433  85.86    329  19.71
## 5  (1.07e+04,1.33e+04]   43  2.58   1476  88.44    236  14.14
## 6   (1.33e+04,1.6e+04]   30  1.80   1506  90.23    193  11.56
## 7   (1.6e+04,1.87e+04]   19  1.14   1525  91.37    163   9.77
## 8  (1.87e+04,2.13e+04]   41  2.46   1566  93.83    144   8.63
## 9   (2.13e+04,2.4e+04]    9  0.54   1575  94.37    103   6.17
## 10  (2.4e+04,2.67e+04]   28  1.68   1603  96.05     94   5.63
## 11 (2.67e+04,2.93e+04]    9  0.54   1612  96.58     66   3.95
## 12  (2.93e+04,3.2e+04]   21  1.26   1633  97.84     57   3.42
## 13  (3.2e+04,3.47e+04]   16  0.96   1649  98.80     36   2.16
## 14 (3.47e+04,3.73e+04]   12  0.72   1661  99.52     20   1.20
## 15    (3.73e+04,4e+04]    8  0.48   1669 100.00      8   0.48

3.2.1 Histograma

par(mar = c(7, 5, 4, 2)) 

h <- hist(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)),
          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.9,
  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

x_vals_1 <- seq_along(Tabla_Final_1$Intervalo)
ymax_1 <- max(Tabla_Final_1$Ni_asc, Tabla_Final_1$Ni_dsc) * 1.1 
plot(x_vals_1, Tabla_Final_1$Ni_asc,
     type = "b", pch = 19, col = "blue", 
     ylim = c(0, ymax_1),
     xaxt = "n",
     main = "Ojiva ascendente (Rango 1)",
     xlab = "Maximo de liberación", 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",
     ylim = c(0, ymax_1),
     xaxt = "n",
     main = "Ojiva descendente (Rango 1)",
     xlab = "Maximo de liberación", 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",
     ylim = c(0, ymax_1),
     xaxt = "n",
     main = "Ojivas Ascendente y Descendente de la Maxima Liberación Petrolera a Nivel Global (Rango 1)",
     cex.main = 0.9,
     xlab = "Maximo de liberación", 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 = Tabla_Final_1$Intervalo, las = 2, cex.axis = 0.7)
legend("topright", legend = c("Ascendente", "Descendente"), col = c("blue", "red"), pch = 19)

3.3 Rango 2: 40001-336000009

breaks_2 <- seq(40001, 3360000009, by = 22397333.86)
rango2 <- Maximo_liberacion_galones[
  Maximo_liberacion_galones >= min(breaks_2) &
    Maximo_liberacion_galones <= max(breaks_2)
]
if (max(rango2) > max(breaks_2)) {
  breaks_2[length(breaks_2)] <- max(rango2) + 0.01
}
rango_2 <- cut(rango2,
               breaks = breaks_2,
               right = TRUE,
               include.lowest = TRUE)

# TABLA DE FRECUENCIAS

TDF_2 <- table(rango_2)
Tabla_2 <- as.data.frame(TDF_2)
hi_2 <- (Tabla_2$Freq / sum(Tabla_2$Freq)) * 100
Tabla_2$hi <- round(hi_2, 2)
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)))
Tabla_Final_2 <- data.frame(
  Intervalo = levels(rango_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)
)

print(Tabla_Final_2)
##               Intervalo  ni    hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1      [4e+04,2.24e+07] 467 97.09    467  97.09    481 100.00
## 2   (2.24e+07,4.48e+07]  11  2.29    478  99.38     14   2.91
## 3   (4.48e+07,6.72e+07]   0  0.00    478  99.38      3   0.62
## 4   (6.72e+07,8.96e+07]   1  0.21    479  99.58      3   0.62
## 5   (8.96e+07,1.12e+08]   0  0.00    479  99.58      2   0.42
## 6   (1.12e+08,1.34e+08]   0  0.00    479  99.58      2   0.42
## 7   (1.34e+08,1.57e+08]   0  0.00    479  99.58      2   0.42
## 8   (1.57e+08,1.79e+08]   0  0.00    479  99.58      2   0.42
## 9   (1.79e+08,2.02e+08]   0  0.00    479  99.58      2   0.42
## 10  (2.02e+08,2.24e+08]   1  0.21    480  99.79      2   0.42
## 11  (2.24e+08,2.46e+08]   0  0.00    480  99.79      1   0.21
## 12  (2.46e+08,2.69e+08]   0  0.00    480  99.79      1   0.21
## 13  (2.69e+08,2.91e+08]   0  0.00    480  99.79      1   0.21
## 14  (2.91e+08,3.14e+08]   0  0.00    480  99.79      1   0.21
## 15  (3.14e+08,3.36e+08]   0  0.00    480  99.79      1   0.21
## 16  (3.36e+08,3.58e+08]   1  0.21    481 100.00      1   0.21
## 17  (3.58e+08,3.81e+08]   0  0.00    481 100.00      0   0.00
## 18  (3.81e+08,4.03e+08]   0  0.00    481 100.00      0   0.00
## 19  (4.03e+08,4.26e+08]   0  0.00    481 100.00      0   0.00
## 20  (4.26e+08,4.48e+08]   0  0.00    481 100.00      0   0.00
## 21   (4.48e+08,4.7e+08]   0  0.00    481 100.00      0   0.00
## 22   (4.7e+08,4.93e+08]   0  0.00    481 100.00      0   0.00
## 23  (4.93e+08,5.15e+08]   0  0.00    481 100.00      0   0.00
## 24  (5.15e+08,5.38e+08]   0  0.00    481 100.00      0   0.00
## 25   (5.38e+08,5.6e+08]   0  0.00    481 100.00      0   0.00
## 26   (5.6e+08,5.82e+08]   0  0.00    481 100.00      0   0.00
## 27  (5.82e+08,6.05e+08]   0  0.00    481 100.00      0   0.00
## 28  (6.05e+08,6.27e+08]   0  0.00    481 100.00      0   0.00
## 29   (6.27e+08,6.5e+08]   0  0.00    481 100.00      0   0.00
## 30   (6.5e+08,6.72e+08]   0  0.00    481 100.00      0   0.00
## 31  (6.72e+08,6.94e+08]   0  0.00    481 100.00      0   0.00
## 32  (6.94e+08,7.17e+08]   0  0.00    481 100.00      0   0.00
## 33  (7.17e+08,7.39e+08]   0  0.00    481 100.00      0   0.00
## 34  (7.39e+08,7.62e+08]   0  0.00    481 100.00      0   0.00
## 35  (7.62e+08,7.84e+08]   0  0.00    481 100.00      0   0.00
## 36  (7.84e+08,8.06e+08]   0  0.00    481 100.00      0   0.00
## 37  (8.06e+08,8.29e+08]   0  0.00    481 100.00      0   0.00
## 38  (8.29e+08,8.51e+08]   0  0.00    481 100.00      0   0.00
## 39  (8.51e+08,8.74e+08]   0  0.00    481 100.00      0   0.00
## 40  (8.74e+08,8.96e+08]   0  0.00    481 100.00      0   0.00
## 41  (8.96e+08,9.18e+08]   0  0.00    481 100.00      0   0.00
## 42  (9.18e+08,9.41e+08]   0  0.00    481 100.00      0   0.00
## 43  (9.41e+08,9.63e+08]   0  0.00    481 100.00      0   0.00
## 44  (9.63e+08,9.86e+08]   0  0.00    481 100.00      0   0.00
## 45  (9.86e+08,1.01e+09]   0  0.00    481 100.00      0   0.00
## 46  (1.01e+09,1.03e+09]   0  0.00    481 100.00      0   0.00
## 47  (1.03e+09,1.05e+09]   0  0.00    481 100.00      0   0.00
## 48  (1.05e+09,1.08e+09]   0  0.00    481 100.00      0   0.00
## 49   (1.08e+09,1.1e+09]   0  0.00    481 100.00      0   0.00
## 50   (1.1e+09,1.12e+09]   0  0.00    481 100.00      0   0.00
## 51  (1.12e+09,1.14e+09]   0  0.00    481 100.00      0   0.00
## 52  (1.14e+09,1.16e+09]   0  0.00    481 100.00      0   0.00
## 53  (1.16e+09,1.19e+09]   0  0.00    481 100.00      0   0.00
## 54  (1.19e+09,1.21e+09]   0  0.00    481 100.00      0   0.00
## 55  (1.21e+09,1.23e+09]   0  0.00    481 100.00      0   0.00
## 56  (1.23e+09,1.25e+09]   0  0.00    481 100.00      0   0.00
## 57  (1.25e+09,1.28e+09]   0  0.00    481 100.00      0   0.00
## 58   (1.28e+09,1.3e+09]   0  0.00    481 100.00      0   0.00
## 59   (1.3e+09,1.32e+09]   0  0.00    481 100.00      0   0.00
## 60  (1.32e+09,1.34e+09]   0  0.00    481 100.00      0   0.00
## 61  (1.34e+09,1.37e+09]   0  0.00    481 100.00      0   0.00
## 62  (1.37e+09,1.39e+09]   0  0.00    481 100.00      0   0.00
## 63  (1.39e+09,1.41e+09]   0  0.00    481 100.00      0   0.00
## 64  (1.41e+09,1.43e+09]   0  0.00    481 100.00      0   0.00
## 65  (1.43e+09,1.46e+09]   0  0.00    481 100.00      0   0.00
## 66  (1.46e+09,1.48e+09]   0  0.00    481 100.00      0   0.00
## 67   (1.48e+09,1.5e+09]   0  0.00    481 100.00      0   0.00
## 68   (1.5e+09,1.52e+09]   0  0.00    481 100.00      0   0.00
## 69  (1.52e+09,1.55e+09]   0  0.00    481 100.00      0   0.00
## 70  (1.55e+09,1.57e+09]   0  0.00    481 100.00      0   0.00
## 71  (1.57e+09,1.59e+09]   0  0.00    481 100.00      0   0.00
## 72  (1.59e+09,1.61e+09]   0  0.00    481 100.00      0   0.00
## 73  (1.61e+09,1.64e+09]   0  0.00    481 100.00      0   0.00
## 74  (1.64e+09,1.66e+09]   0  0.00    481 100.00      0   0.00
## 75  (1.66e+09,1.68e+09]   0  0.00    481 100.00      0   0.00
## 76   (1.68e+09,1.7e+09]   0  0.00    481 100.00      0   0.00
## 77   (1.7e+09,1.72e+09]   0  0.00    481 100.00      0   0.00
## 78  (1.72e+09,1.75e+09]   0  0.00    481 100.00      0   0.00
## 79  (1.75e+09,1.77e+09]   0  0.00    481 100.00      0   0.00
## 80  (1.77e+09,1.79e+09]   0  0.00    481 100.00      0   0.00
## 81  (1.79e+09,1.81e+09]   0  0.00    481 100.00      0   0.00
## 82  (1.81e+09,1.84e+09]   0  0.00    481 100.00      0   0.00
## 83  (1.84e+09,1.86e+09]   0  0.00    481 100.00      0   0.00
## 84  (1.86e+09,1.88e+09]   0  0.00    481 100.00      0   0.00
## 85   (1.88e+09,1.9e+09]   0  0.00    481 100.00      0   0.00
## 86   (1.9e+09,1.93e+09]   0  0.00    481 100.00      0   0.00
## 87  (1.93e+09,1.95e+09]   0  0.00    481 100.00      0   0.00
## 88  (1.95e+09,1.97e+09]   0  0.00    481 100.00      0   0.00
## 89  (1.97e+09,1.99e+09]   0  0.00    481 100.00      0   0.00
## 90  (1.99e+09,2.02e+09]   0  0.00    481 100.00      0   0.00
## 91  (2.02e+09,2.04e+09]   0  0.00    481 100.00      0   0.00
## 92  (2.04e+09,2.06e+09]   0  0.00    481 100.00      0   0.00
## 93  (2.06e+09,2.08e+09]   0  0.00    481 100.00      0   0.00
## 94  (2.08e+09,2.11e+09]   0  0.00    481 100.00      0   0.00
## 95  (2.11e+09,2.13e+09]   0  0.00    481 100.00      0   0.00
## 96  (2.13e+09,2.15e+09]   0  0.00    481 100.00      0   0.00
## 97  (2.15e+09,2.17e+09]   0  0.00    481 100.00      0   0.00
## 98  (2.17e+09,2.19e+09]   0  0.00    481 100.00      0   0.00
## 99  (2.19e+09,2.22e+09]   0  0.00    481 100.00      0   0.00
## 100 (2.22e+09,2.24e+09]   0  0.00    481 100.00      0   0.00
## 101 (2.24e+09,2.26e+09]   0  0.00    481 100.00      0   0.00
## 102 (2.26e+09,2.28e+09]   0  0.00    481 100.00      0   0.00
## 103 (2.28e+09,2.31e+09]   0  0.00    481 100.00      0   0.00
## 104 (2.31e+09,2.33e+09]   0  0.00    481 100.00      0   0.00
## 105 (2.33e+09,2.35e+09]   0  0.00    481 100.00      0   0.00
## 106 (2.35e+09,2.37e+09]   0  0.00    481 100.00      0   0.00
## 107  (2.37e+09,2.4e+09]   0  0.00    481 100.00      0   0.00
## 108  (2.4e+09,2.42e+09]   0  0.00    481 100.00      0   0.00
## 109 (2.42e+09,2.44e+09]   0  0.00    481 100.00      0   0.00
## 110 (2.44e+09,2.46e+09]   0  0.00    481 100.00      0   0.00
## 111 (2.46e+09,2.49e+09]   0  0.00    481 100.00      0   0.00
## 112 (2.49e+09,2.51e+09]   0  0.00    481 100.00      0   0.00
## 113 (2.51e+09,2.53e+09]   0  0.00    481 100.00      0   0.00
## 114 (2.53e+09,2.55e+09]   0  0.00    481 100.00      0   0.00
## 115 (2.55e+09,2.58e+09]   0  0.00    481 100.00      0   0.00
## 116  (2.58e+09,2.6e+09]   0  0.00    481 100.00      0   0.00
## 117  (2.6e+09,2.62e+09]   0  0.00    481 100.00      0   0.00
## 118 (2.62e+09,2.64e+09]   0  0.00    481 100.00      0   0.00
## 119 (2.64e+09,2.67e+09]   0  0.00    481 100.00      0   0.00
## 120 (2.67e+09,2.69e+09]   0  0.00    481 100.00      0   0.00
## 121 (2.69e+09,2.71e+09]   0  0.00    481 100.00      0   0.00
## 122 (2.71e+09,2.73e+09]   0  0.00    481 100.00      0   0.00
## 123 (2.73e+09,2.75e+09]   0  0.00    481 100.00      0   0.00
## 124 (2.75e+09,2.78e+09]   0  0.00    481 100.00      0   0.00
## 125  (2.78e+09,2.8e+09]   0  0.00    481 100.00      0   0.00
## 126  (2.8e+09,2.82e+09]   0  0.00    481 100.00      0   0.00
## 127 (2.82e+09,2.84e+09]   0  0.00    481 100.00      0   0.00
## 128 (2.84e+09,2.87e+09]   0  0.00    481 100.00      0   0.00
## 129 (2.87e+09,2.89e+09]   0  0.00    481 100.00      0   0.00
## 130 (2.89e+09,2.91e+09]   0  0.00    481 100.00      0   0.00
## 131 (2.91e+09,2.93e+09]   0  0.00    481 100.00      0   0.00
## 132 (2.93e+09,2.96e+09]   0  0.00    481 100.00      0   0.00
## 133 (2.96e+09,2.98e+09]   0  0.00    481 100.00      0   0.00
## 134    (2.98e+09,3e+09]   0  0.00    481 100.00      0   0.00
## 135    (3e+09,3.02e+09]   0  0.00    481 100.00      0   0.00
## 136 (3.02e+09,3.05e+09]   0  0.00    481 100.00      0   0.00
## 137 (3.05e+09,3.07e+09]   0  0.00    481 100.00      0   0.00
## 138 (3.07e+09,3.09e+09]   0  0.00    481 100.00      0   0.00
## 139 (3.09e+09,3.11e+09]   0  0.00    481 100.00      0   0.00
## 140 (3.11e+09,3.14e+09]   0  0.00    481 100.00      0   0.00
## 141 (3.14e+09,3.16e+09]   0  0.00    481 100.00      0   0.00
## 142 (3.16e+09,3.18e+09]   0  0.00    481 100.00      0   0.00
## 143  (3.18e+09,3.2e+09]   0  0.00    481 100.00      0   0.00
## 144  (3.2e+09,3.23e+09]   0  0.00    481 100.00      0   0.00
## 145 (3.23e+09,3.25e+09]   0  0.00    481 100.00      0   0.00
## 146 (3.25e+09,3.27e+09]   0  0.00    481 100.00      0   0.00
## 147 (3.27e+09,3.29e+09]   0  0.00    481 100.00      0   0.00
## 148 (3.29e+09,3.31e+09]   0  0.00    481 100.00      0   0.00
## 149 (3.31e+09,3.34e+09]   0  0.00    481 100.00      0   0.00
## 150 (3.34e+09,3.36e+09]   0  0.00    481 100.00      0   0.00

3.3.1 Histograma

par(mar = c(7, 5, 4, 2)) 

h <- hist(rango2,
          breaks = breaks_2,
          freq = TRUE,
          main = "Distribución de la Maxima Liberación Petrolera a Nivel Global(Rango 2)",
          xlab = "Máximo de liberación (galones)",
          ylab = "Frecuencia",
          col = terrain.colors(length(Tabla_Final_2$ni)),
          border = "black",
          las = 1)

text(h$mids,
     h$counts,
     labels = h$counts,
     pos = 3,
     cex = 0.8,
     col = "black")

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.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)",
     cex.main = 0.9,
     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)
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

options(scipen = 999)

4.1 Extraer la variable

Volumen_derramados_galones <- as.numeric(datos$Volumen_derramados_galones)
## Warning: NAs introduced by coercion
Volumen_derramados_galones <- na.omit(Volumen_derramados_galones)

4.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.17

4.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.9,
  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.9,
      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.9,
         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      0

4.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.9,
  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.9,
      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(x_rango2),
         labels = format(pretty(x_rango2), scientific = FALSE))

4.3.3 Ojiva ascendente y descendente

    x_vals_2 <- seq_along(Tabla_Final_2$Intervalo)
    ymax_2 <- max(Tabla_Final_2$Ni_asc) * 1.1
    
    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.7)

    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.7)

    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)",
         cex.main = 0.9,
         xlab = "Volumen Derramado", ylab = "Frecuencia acumulada")
    lines(x_vals_2, Tabla_Final_2$Ni_dsc, col = "red", lwd = 2, type = "b", pch = 19)
    axis(1, at = x_vals_2, labels = Tabla_Final_2$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.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

options(scipen = 999)

5.1 Extraer la variable

Respuesta_actual_galones <- as.numeric(datos$Respuesta_actual_galones)
## Warning: NAs introduced by coercion
Respuesta_actual_galones <- na.omit(Respuesta_actual_galones)

5.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.63

5.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.9,
  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, 336000000, by = 16800000 )
cut_2 <- cut(Respuesta_actual_galones[
  Respuesta_actual_galones >= 10001 & Respuesta_actual_galones <=  336000000
],
breaks = breaks_2, right = TRUE, include.lowest = TRUE)
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)))
Tabla_Final_2 <- data.frame(
  Intervalo = as.character(Tabla_2$cut_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)
)
print(Tabla_Final_2)
##              Intervalo  ni    hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1     [1e+04,1.68e+07] 429 97.72    429  97.72    439 100.00
## 2  (1.68e+07,3.36e+07]   5  1.14    434  98.86     10   2.28
## 3  (3.36e+07,5.04e+07]   2  0.46    436  99.32      5   1.14
## 4  (5.04e+07,6.72e+07]   0  0.00    436  99.32      3   0.68
## 5   (6.72e+07,8.4e+07]   1  0.23    437  99.54      3   0.68
## 6   (8.4e+07,1.01e+08]   0  0.00    437  99.54      2   0.46
## 7  (1.01e+08,1.18e+08]   0  0.00    437  99.54      2   0.46
## 8  (1.18e+08,1.34e+08]   0  0.00    437  99.54      2   0.46
## 9  (1.34e+08,1.51e+08]   0  0.00    437  99.54      2   0.46
## 10 (1.51e+08,1.68e+08]   1  0.23    438  99.77      2   0.46
## 11 (1.68e+08,1.85e+08]   0  0.00    438  99.77      1   0.23
## 12 (1.85e+08,2.02e+08]   0  0.00    438  99.77      1   0.23
## 13 (2.02e+08,2.18e+08]   0  0.00    438  99.77      1   0.23
## 14 (2.18e+08,2.35e+08]   0  0.00    438  99.77      1   0.23
## 15 (2.35e+08,2.52e+08]   1  0.23    439 100.00      1   0.23
## 16 (2.52e+08,2.69e+08]   0  0.00    439 100.00      0   0.00
## 17 (2.69e+08,2.86e+08]   0  0.00    439 100.00      0   0.00
## 18 (2.86e+08,3.02e+08]   0  0.00    439 100.00      0   0.00
## 19 (3.02e+08,3.19e+08]   0  0.00    439 100.00      0   0.00

5.3.1 Histograma

barplot(
  Tabla_Final_2$ni,
  names.arg = Tabla_Final_2$Intervalo,
  col = "skyblue",
  main = " Distribución de la Cantidad recolectada de los derrames a Nivel Global (Rango 2)",
  xlab = "Cantidad recolectada",
  ylab = "Frecuencia",
  las = 2,
  cex.names = 0.6,
  border = "black")

5.3.2 Diagrama de caja

boxplot(
  Respuesta_actual_galones[
    Respuesta_actual_galones >= 10001 & Respuesta_actual_galones <= 336000000 ],
  horizontal = TRUE,
  col = "lightblue",
  main = "Distribución de la Cantidad recolectada de los derrames a Nivel Global (Rango 2)",
  xlab = "Cantidad Recolectada",
  cex.main = 0.95,
   xaxt = "n")

axis(1,
     at = pretty(Respuesta_actual_galones[
       Respuesta_actual_galones >= 10001 & Respuesta_actual_galones <= 336000000
     ]),
     labels = format(pretty(Respuesta_actual_galones[
       Respuesta_actual_galones >= 10001 & Respuesta_actual_galones <= 336000000
     ]),
     scientific = FALSE)
)

5.3.3 Ojiva ascendente y descendente

x_vals_2 <- seq_along(Tabla_Final_2$Intervalo)
ymax_2 <- max(Tabla_Final_2$Ni_asc) * 1.1
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 = "Cantidad Recolectada", ylab = "Frecuencia acumulada")
axis(1, at = x_vals_2, labels = Tabla_Final_2$Intervalo, las = 2, cex.axis = 0.7)

plot(x_vals_2, rev(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 = "Cantidad Recolectada", 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", lwd = 2,
     ylim = c(0, ymax_2),
     xaxt = "n",
     main = "Ojivas Ascendente y Descendente de la Cantidad recolectada de los derrames a Nivel Global (Rango 2)",
     xlab = "Cantidad Recolectada", ylab = "Frecuencia acumulada")
lines(x_vals_2, rev(Tabla_Final_2$Ni_dsc),
      col = "red", lwd = 2, type = "b", pch = 19)
axis(1, at = x_vals_2, labels = Tabla_Final_2$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.8)

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.