Cargar los datos y librerías
setwd("D:/Data")
datos <- read.csv("derrames_globales_.csv", header = TRUE, sep = ";", dec =".")
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.5.2
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(janitor)
## Warning: package 'janitor' was built under R version 4.5.2
##
## Adjuntando el paquete: 'janitor'
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
library(e1071)
## Warning: package 'e1071' was built under R version 4.5.2
df <- clean_names(datos)
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 ...
## $ ANo : 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" ...
## $ Recuperacion_en_superficie_aplicada: int NA NA 1 NA NA NA NA NA NA NA ...
## $ Recuperacion_en_costas_aplicada : int NA NA 1 NA NA NA NA NA NA NA ...
## $ Tratamiento_biologico_aplicado : int 1 NA 1 1 NA NA NA NA NA NA ...
## $ Dispersion_quimica_aplicada : int NA 1 1 1 NA NA NA 1 1 1 ...
## $ Quema_aplicada : int NA 1 1 NA NA NA NA 1 1 1 ...
## $ Maximo_liberacion_galones : int 336000009 -1 205000000 68000017 -1 -1 -1 9240000 36100000 -1 ...
## $ Barreras_de_contencion_flotantes : int 35 12 182 17 3 3 7 8 5 6 ...
## $ Causa_principal : chr "DaNo del tanque " "Incendio y explosion " "Incendio y explosion " "DaNo 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" ...
# Preparación de la variable
mes <- as.numeric(df$mes)
mes <- na.omit(mes)
# Creación de la tabla
TDF_mes <- table(mes)
Tabla_mes <- as.data.frame(TDF_mes)
names(Tabla_mes) <- c("mes", "Freq")
# Cálculos de frecuencias relativas y acumuladas
hi_mes <- (Tabla_mes$Freq / sum(Tabla_mes$Freq) * 100)
Ni_asc <- cumsum(Tabla_mes$Freq)
Hi_asc <- cumsum(hi_mes)
Ni_dsc <- rev(cumsum(rev(Tabla_mes$Freq)))
Hi_dsc <- rev(cumsum(rev(hi_mes)))
Tabla_mes_Final <- data.frame(
Mes = as.numeric(as.character(Tabla_mes$mes)),
ni = Tabla_mes$Freq,
hi = round(hi_mes, 2),
Ni_asc = Ni_asc,
Hi_asc = round(Hi_asc, 2),
Ni_dsc = Ni_dsc,
Hi_dsc = round(Hi_dsc, 2)
)
print(Tabla_mes_Final)
## Mes ni hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1 1 308 8.68 308 8.68 3550 100.00
## 2 2 324 9.13 632 17.80 3242 91.32
## 3 3 292 8.23 924 26.03 2918 82.20
## 4 4 263 7.41 1187 33.44 2626 73.97
## 5 5 263 7.41 1450 40.85 2363 66.56
## 6 6 287 8.08 1737 48.93 2100 59.15
## 7 7 326 9.18 2063 58.11 1813 51.07
## 8 8 323 9.10 2386 67.21 1487 41.89
## 9 9 267 7.52 2653 74.73 1164 32.79
## 10 10 312 8.79 2965 83.52 897 25.27
## 11 11 285 8.03 3250 91.55 585 16.48
## 12 12 300 8.45 3550 100.00 300 8.45
nombres_meses <- c("Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct","Nov","Dic")
ylim_max <- max(Tabla_mes_Final$ni) * 1.1
ymax_ojiva <- max(Tabla_mes_Final$Ni_asc) * 1.1
barplot(Tabla_mes_Final$ni, main = "Distribución de derrames por Meses",
xlab = "Meses del año", ylab = "Cantidad", col = "blue",
names.arg = nombres_meses, ylim = c(0, ylim_max), las = 2, cex.names = 0.8)
boxplot(mes, horizontal = TRUE, col = "darkblue",
main = "Boxplot de los Meses de Derrames", xlab = "Meses del año")
plot(1:12, Tabla_mes_Final$Ni_asc, type = "p", pch = 19, col = "blue", xaxt = "n",
ylim = c(0, ymax_ojiva),
main = "Gráfica de Ojiva ascendente de meses",
xlab = "Meses (1=Enero, 12=Diciembre)", ylab = "Cantidad")
axis(1, at = 1:12, labels = nombres_meses, las = 2)
plot(1:12, Tabla_mes_Final$Ni_dsc, type = "p", pch = 19, col = "red", xaxt = "n",
ylim = c(0, ymax_ojiva),
main = "Gráfica de Ojivas descendentes de meses en los que ocurren los derrames",
xlab = "Meses (1=Enero, 12=Diciembre)", ylab = "Cantidad")
axis(1, at = 1:12, labels = nombres_meses, las = 2)
plot(1:12, Tabla_mes_Final$Ni_asc, type = "p", pch = 19, col = "blue", xaxt = "n",
ylim = c(0, ymax_ojiva),
main = "Gráfica de Ojivas de meses",
xlab = "Meses (1=Enero, 12=Diciembre)", ylab = "Cantidad")
points(1:12, Tabla_mes_Final$Ni_dsc, col = "red", pch = 19)
axis(1, at = 1:12, labels = nombres_meses, las = 2)
legend("topright", legend = c("Ascendente", "Descendente"), col = c("blue", "red"), pch = 19)
# Cálculos de todos los indicadores
media_mes <- mean(mes)
mediana_mes <- median(mes)
moda_mes <- as.numeric(names(sort(table(mes), decreasing = TRUE)[1]))
varianza_mes <- var(mes)
desv_estandar_mes <- sd(mes)
coef_variacion_mes <- (desv_estandar_mes / media_mes) * 100
asimetria_mes <- skewness(mes)
curtosis_mes <- kurtosis(mes)
# Creación de la tabla consolidada
indicadores_mes <- data.frame(
Indicador = c("Moda",
"Mediana",
"Media (x̄)",
"Desviación Estándar (σ)",
"Varianza (σ²)",
"Coef. Variación (%)",
"Asimetría",
"Curtosis"),
Valor = c(moda_mes,
mediana_mes,
round(media_mes, 2),
round(desv_estandar_mes, 2),
round(varianza_mes, 2),
round(coef_variacion_mes, 2),
round(asimetria_mes, 2),
round(curtosis_mes, 2))
)
# Impresión de la tabla
cat("Tabla de Indicadores: Mes\n\n")
## Tabla de Indicadores: Mes
print(indicadores_mes)
## Indicador Valor
## 1 Moda 7.00
## 2 Mediana 7.00
## 3 Media (x̄) 6.49
## 4 Desviación Estándar (σ) 3.48
## 5 Varianza (σ²) 12.09
## 6 Coef. Variación (%) 53.56
## 7 Asimetría -0.02
## 8 Curtosis -1.23
Conclusiones
El comportamiento de la variable de los meses fluctúa entre [1-12] con una tendencia central situada en torno a la mediana de 7 y una desviación estándar de 3.48, siendo un conjunto con datos dispersos y un coeficiente de variación heterogéneo. La distribución muestra un sesgo levemente negativo, sin presencia significativa de valores atípicos dado su comportamiento uniforme, lo cual no es nada beneficioso ya que existen derrames permanentes en la industria.
ano_raw <- as.character(datos[, 4])
ano <- suppressWarnings(as.numeric(ano_raw))
ano <- na.omit(ano)
# Definición de Intervalos de 6 años
breaks <- seq(min(ano), max(ano) + 6, by = 6)
labels_intervalos <- paste(breaks[-length(breaks)], breaks[-1] - 1, sep = "-")
ano_intervalos <- cut(ano, breaks = breaks, labels = labels_intervalos, include.lowest = TRUE, right = FALSE)
# Creación de la tabla
TDF_ano <- table(ano_intervalos)
Tabla_ano <- as.data.frame(TDF_ano)
names(Tabla_ano) <- c("ano_intervalos", "Freq")
# Eliminar intervalos vacíos si los hay
Tabla_ano <- Tabla_ano[Tabla_ano$Freq > 0, ]
# Cálculos de frecuencias relativas y acumuladas
hi_ano <- (Tabla_ano$Freq / sum(Tabla_ano$Freq) * 100)
Ni_asc <- cumsum(Tabla_ano$Freq)
Hi_asc <- cumsum(hi_ano)
Ni_dsc <- rev(cumsum(rev(Tabla_ano$Freq)))
Hi_dsc <- rev(cumsum(rev(hi_ano)))
Tabla_ano_Final <- data.frame(
Intervalo = Tabla_ano$ano_intervalos,
ni = Tabla_ano$Freq,
hi = round(hi_ano, 2),
Ni_asc = Ni_asc,
Hi_asc = round(Hi_asc, 2),
Ni_dsc = Ni_dsc,
Hi_dsc = round(Hi_dsc, 2)
)
print(Tabla_ano_Final)
## Intervalo ni hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1 1957-1962 1 0.03 1 0.03 3549 100.00
## 2 1963-1968 5 0.14 6 0.17 3548 99.97
## 3 1969-1974 15 0.42 21 0.59 3543 99.83
## 4 1975-1980 37 1.04 58 1.63 3528 99.41
## 5 1981-1986 244 6.88 302 8.51 3491 98.37
## 6 1987-1992 353 9.95 655 18.46 3247 91.49
## 7 1993-1998 349 9.83 1004 28.29 2894 81.54
## 8 1999-2004 343 9.66 1347 37.95 2545 71.71
## 9 2005-2010 625 17.61 1972 55.56 2202 62.05
## 10 2011-2016 587 16.54 2559 72.10 1577 44.44
## 11 2017-2022 867 24.43 3426 96.53 990 27.90
## 12 2023-2028 123 3.47 3549 100.00 123 3.47
x_vals <- 1:nrow(Tabla_ano_Final)
ymax_ano <- max(Tabla_ano_Final$Ni_asc) * 1.1
# 1. Gráfico de Barras (Histograma)
barplot(Tabla_ano_Final$ni, names.arg = Tabla_ano_Final$Intervalo, col = "blue",
main = "Diagrama de Barras: Distribución de derrames por intervalos de 6 años",
xlab = "Intervalos de años", ylab = "Cantidad", las = 2, cex.names = 0.7)
boxplot(ano, horizontal = TRUE, col = "darkblue",
main = "Distribución de años en los que ocurren los derrames", xlab = "Años")
plot(x_vals, Tabla_ano_Final$Ni_asc, type = "p", pch = 19, col = "blue", xaxt = "n",
ylim = c(0, ymax_ano), main = "Gráfica de Ojiva ascendente de intervalos de años",
xlab = "Intervalos de años", ylab = "Cantidad")
axis(1, at = x_vals, labels = Tabla_ano_Final$Intervalo, las = 2, cex.axis = 0.7)
plot(x_vals, Tabla_ano_Final$Ni_dsc, type = "p", pch = 19, col = "red", xaxt = "n",
ylim = c(0, ymax_ano), main = "Gráfica de Ojiva descendente de intervalos de años",
xlab = "Intervalos de años", ylab = "Cantidad")
axis(1, at = x_vals, labels = Tabla_ano_Final$Intervalo, las = 2, cex.axis = 0.7)
plot(x_vals, Tabla_ano_Final$Ni_asc, type = "p", pch = 19, col = "blue", xaxt = "n",
ylim = c(0, ymax_ano), main = "Gráfica de Ojivas de intervalos de años",
xlab = "Intervalos de años", ylab = "Cantidad")
points(x_vals, Tabla_ano_Final$Ni_dsc, col = "red", pch = 19)
axis(1, at = x_vals, labels = Tabla_ano_Final$Intervalo, las = 2, cex.axis = 0.7)
legend("topright", legend = c("Ascendente", "Descendente"), col = c("blue", "red"), pch = 19)
# Cálculos de todos los indicadores principales
media_ano <- mean(ano)
mediana_ano <- median(ano)
moda_ano_calc <- as.numeric(names(sort(table(ano), decreasing = TRUE)[1]))
varianza_ano <- var(ano)
desv_estandar_ano <- sd(ano)
coef_variacion_ano <- (desv_estandar_ano / media_ano) * 100
asimetria_ano <- skewness(ano)
curtosis_ano <- kurtosis(ano)
# Creación de la tabla consolidada
indicadores_ano <- data.frame(
Indicador = c("Moda (datos crudos)",
"Mediana",
"Media (x̄)",
"Desviación Estándar (σ)",
"Varianza (σ²)",
"Coef. Variación (%)",
"Asimetría",
"Curtosis"),
Valor = c(moda_ano_calc,
mediana_ano,
round(media_ano, 2),
round(desv_estandar_ano, 2),
round(varianza_ano, 2),
round(coef_variacion_ano, 2),
round(asimetria_ano, 2),
round(curtosis_ano, 2))
)
# Impresión de la tabla
cat("Tabla de Indicadores: Año\n\n")
## Tabla de Indicadores: Año
print(indicadores_ano)
## Indicador Valor
## 1 Moda (datos crudos) 2016.00
## 2 Mediana 2009.00
## 3 Media (x̄) 2006.43
## 4 Desviación Estándar (σ) 12.41
## 5 Varianza (σ²) 154.11
## 6 Coef. Variación (%) 0.62
## 7 Asimetría -0.57
## 8 Curtosis -0.70
Conclusiones
El comportamiento de la variable de los años fluctúa entre [1957-2022] con una tendencia central situada en torno a la mediana de 2009 y una desviación estándar de 12.41, siendo un conjunto con datos poco dispersos y un coeficiente de variación homogéneo. La distribución muestra un sesgo negativo, con la presencia de un valor atípico antes del año de 1960, lo cual es debilmente beneficioso ya que evidencia que la gran mayoría de los derrames se concentran fuertemente en las décadas más recientes de la industria petrolera.
barreras <- as.numeric(df$barreras_de_contencion_flotantes)
barreras <- na.omit(barreras)
# Definición de Intervalos de 30 en 30
limite_sup <- ceiling(max(barreras) / 30) * 30
breaks_barreras <- seq(0, limite_sup, by = 30)
labels_barreras <- paste(breaks_barreras[-length(breaks_barreras)], breaks_barreras[-1] - 1, sep = "-")
# Agrupación de los datos
barreras_intervalos <- cut(barreras, breaks = breaks_barreras, labels = labels_barreras, include.lowest = TRUE, right = FALSE)
# Creación de la tabla
TDF_barreras <- table(barreras_intervalos)
Tabla_barreras <- as.data.frame(TDF_barreras)
names(Tabla_barreras) <- c("Intervalo", "Freq")
# Eliminar intervalos vacíos para mantener la tabla limpia
Tabla_barreras <- Tabla_barreras[Tabla_barreras$Freq > 0, ]
# Cálculos de frecuencias relativas y acumuladas
hi_barreras <- (Tabla_barreras$Freq / sum(Tabla_barreras$Freq) * 100)
Ni_asc <- cumsum(Tabla_barreras$Freq)
Hi_asc <- cumsum(hi_barreras)
Ni_dsc <- rev(cumsum(rev(Tabla_barreras$Freq)))
Hi_dsc <- rev(cumsum(rev(hi_barreras)))
Tabla_barreras_Final <- data.frame(
Intervalo = Tabla_barreras$Intervalo,
ni = Tabla_barreras$Freq,
hi = round(hi_barreras, 2),
Ni_asc = Ni_asc,
Hi_asc = round(Hi_asc, 2),
Ni_dsc = Ni_dsc,
Hi_dsc = round(Hi_dsc, 2)
)
print(Tabla_barreras_Final)
## Intervalo ni hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1 0-29 3430 96.62 3430 96.62 3550 100.00
## 2 30-59 67 1.89 3497 98.51 120 3.38
## 3 60-89 21 0.59 3518 99.10 53 1.49
## 4 90-119 9 0.25 3527 99.35 32 0.90
## 5 120-149 8 0.23 3535 99.58 23 0.65
## 6 150-179 5 0.14 3540 99.72 15 0.42
## 7 180-209 2 0.06 3542 99.77 10 0.28
## 8 210-239 2 0.06 3544 99.83 8 0.23
## 9 240-269 1 0.03 3545 99.86 6 0.17
## 10 270-299 2 0.06 3547 99.92 5 0.14
## 11 300-329 1 0.03 3548 99.94 3 0.08
## 12 330-359 1 0.03 3549 99.97 2 0.06
## 13 360-389 1 0.03 3550 100.00 1 0.03
x_vals <- 1:nrow(Tabla_barreras_Final)
ymax_barreras <- max(Tabla_barreras_Final$Ni_asc) * 1.1
barplot(Tabla_barreras_Final$ni, names.arg = Tabla_barreras_Final$Intervalo, col = "blue",
main = "Distribución de Barreras de Contención (Intervalos de 30)",
xlab = "Intervalos de Barreras", ylab = "Cantidad", las = 2, cex.names = 0.7)
boxplot(barreras, horizontal = TRUE, col = "darkblue",
main = "Distribución de barreras en los que ocurren los derrames", xlab = "Cantidad de Barreras")
plot(x_vals, Tabla_barreras_Final$Ni_asc, type = "p", pch = 19, col = "blue", xaxt = "n",
ylim = c(0, ymax_barreras), main = "Gráfica de Ojiva ascendente de barreras",
xlab = "Intervalos de Barreras", ylab = "Cantidad")
axis(1, at = x_vals, labels = Tabla_barreras_Final$Intervalo, las = 2, cex.axis = 0.7)
plot(x_vals, Tabla_barreras_Final$Ni_dsc, type = "p", pch = 19, col = "red", xaxt = "n",
ylim = c(0, ymax_barreras), main = "Gráfica de Ojiva descendente de barreras",
xlab = "Intervalos de Barreras", ylab = "Cantidad")
axis(1, at = x_vals, labels = Tabla_barreras_Final$Intervalo, las = 2, cex.axis = 0.7)
plot(x_vals, Tabla_barreras_Final$Ni_asc, type = "p", pch = 19, col = "blue", xaxt = "n",
ylim = c(0, ymax_barreras), main = "Gráfica de Ojivas de barreras",
xlab = "Intervalos de Barreras", ylab = "Cantidad")
points(x_vals, Tabla_barreras_Final$Ni_dsc, col = "red", pch = 19)
axis(1, at = x_vals, labels = Tabla_barreras_Final$Intervalo, las = 2, cex.axis = 0.7)
legend("topright", legend = c("Ascendente", "Descendente"), col = c("blue", "red"), pch = 19)
# Cálculos de todos los indicadores principales
media_barreras <- mean(barreras)
mediana_barreras <- median(barreras)
moda_barreras <- as.numeric(names(sort(table(barreras), decreasing = TRUE)[1]))
varianza_barreras <- var(barreras)
desv_estandar_barreras <- sd(barreras)
coef_variacion_barreras <- (desv_estandar_barreras / media_barreras) * 100
asimetria_barreras <- skewness(barreras)
curtosis_barreras <- kurtosis(barreras)
# Creación de la tabla consolidada
indicadores_barreras <- data.frame(
Indicador = c("Moda (datos crudos)",
"Mediana",
"Media (x̄)",
"Desviación Estándar (σ)",
"Varianza (σ²)",
"Coef. Variación (%)",
"Asimetría",
"Curtosis"),
Valor = c(moda_barreras,
mediana_barreras,
round(media_barreras, 2),
round(desv_estandar_barreras, 2),
round(varianza_barreras, 2),
round(coef_variacion_barreras, 2),
round(asimetria_barreras, 2),
round(curtosis_barreras, 2))
)
# Impresión de la tabla
cat("Tabla de Indicadores: Barreras de Contención\n\n")
## Tabla de Indicadores: Barreras de Contención
print(indicadores_barreras)
## Indicador Valor
## 1 Moda (datos crudos) 0.00
## 2 Mediana 1.00
## 3 Media (x̄) 6.18
## 4 Desviación Estándar (σ) 19.56
## 5 Varianza (σ²) 382.65
## 6 Coef. Variación (%) 316.60
## 7 Asimetría 9.99
## 8 Curtosis 134.37
Conclusiones
El comportamiento de la variable de las barreras de contención fluctúa entre [0-346] con una tendencia central situada en torno a la mediana de 1 y una desviación estándar de 19.56, siendo un conjunto con datos altamente dispersos y un coeficiente de variación muy heterogéneo. La distribución muestra un sesgo positivo muy marcado, con la presencia de múltiples valores atípicos a partir de las 15 barreras, lo cual es escasamente beneficioso ya que evidencia una contención mínima en la gran mayoría de los incidentes.