This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
knitr::opts_chunk$set(echo = TRUE)
# Librerías
install.packages("dplyr")
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.5'
## (as 'lib' is unspecified)
install.packages("readxl")
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.5'
## (as 'lib' is unspecified)
install.packages("janitor")
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.5'
## (as 'lib' is unspecified)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(readxl)
library(janitor)
##
## Attaching package: 'janitor'
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
# Cargar el archivo desde el directorio raíz
df <- read_excel("Derrames.xlsx", sheet = 1) %>%
clean_names()
# Exploración inicial
dim(df)
## [1] 3550 23
head(df)
## # A tibble: 6 × 23
## id dia mes ano nombre ubicacion latitud longuitud amenaza etiquetas
## <dbl> <dbl> <dbl> <chr> <chr> <chr> <dbl> <dbl> <chr> <chr>
## 1 6786 19 1 A Arabian… Persian … 29.5 48 Oil <NA>
## 2 6250 3 6 1979 IXTOC I… Bahia de… 19.4 -92.3 Oil Collision
## 3 8220 21 4 2010 Deepwat… Gulf of … 28.7 -88.4 Oil <NA>
## 4 6241 16 3 1978 Amoco C… Brittany… 48.6 -4.72 Oil Grounding
## 5 6216 19 12 1972 Sea Sta… Gulf of … 25.3 57.6 Unknown <NA>
## 6 6620 7 10 1988 M/V JAH… Delaware… 39.8 -75.4 Unknown <NA>
## # ℹ 13 more variables: tipo_de_crudo <chr>,
## # cantidad_recuperada_superficie <dbl>, cantidad_recuperada_costas <dbl>,
## # cantidad_tratada_biologicamente <dbl>,
## # cantidad_dispersada_quimicamente <dbl>, cantidad_quemada <dbl>,
## # maximo_liberacion_galones <dbl>, barreras_de_contencion_flotantes <dbl>,
## # causa_principal <chr>, volumen_derramados_galones <chr>,
## # respuesta_actual_galones <dbl>, fuente_respuesta <chr>, …
glimpse(df)
## Rows: 3,550
## Columns: 23
## $ id <dbl> 6786, 6250, 8220, 6241, 6216, 6620, 6…
## $ dia <dbl> 19, 3, 21, 16, 19, 7, 10, 12, 18, 29,…
## $ mes <dbl> 1, 6, 4, 3, 12, 10, 2, 5, 3, 1, 12, 6…
## $ ano <chr> "A", "1979", "2010", "1978", "1972", …
## $ nombre <chr> "Arabian Gulf Spills; Persian Gulf, K…
## $ ubicacion <chr> "Persian Gulf, Kuwait", "Bahia de Cam…
## $ latitud <dbl> 29.50000, 19.40830, 28.73670, 48.5833…
## $ longuitud <dbl> 48.00000, -92.32500, -88.38720, -4.71…
## $ amenaza <chr> "Oil", "Oil", "Oil", "Oil", "Unknown"…
## $ etiquetas <chr> NA, "Collision", NA, "Grounding", NA,…
## $ tipo_de_crudo <chr> "Kuwait crude oil", "IXTOC I crude oi…
## $ cantidad_recuperada_superficie <dbl> NA, NA, 1, NA, NA, NA, NA, NA, NA, NA…
## $ cantidad_recuperada_costas <dbl> NA, NA, 1, NA, NA, NA, NA, NA, NA, NA…
## $ cantidad_tratada_biologicamente <dbl> 1, NA, 1, 1, NA, NA, NA, NA, NA, NA, …
## $ cantidad_dispersada_quimicamente <dbl> NA, 1, 1, 1, NA, NA, NA, 1, 1, 1, 1, …
## $ cantidad_quemada <dbl> NA, 1, 1, NA, NA, NA, NA, 1, 1, 1, NA…
## $ maximo_liberacion_galones <dbl> 336000009, -1, 205000000, 68000017, -…
## $ barreras_de_contencion_flotantes <dbl> 35, 12, 182, 17, 3, 3, 7, 8, 5, 6, 7,…
## $ causa_principal <chr> "Daño del tanque", "Incendio y explos…
## $ volumen_derramados_galones <chr> "336000000", "365000000", "600000000"…
## $ respuesta_actual_galones <dbl> 336000000, 252000000, 168000000, 6870…
## $ fuente_respuesta <chr> "description and posts", "posts", "de…
## $ etiqueta_actualizacion <chr> "RA updated", "RA newly acquired", "R…
# VARIABLE "mes"
mes <- as.numeric(df$mes)
mes <- na.omit(mes)
# Tabla de frecuencias
TDF_mes <- table(mes)
Tabla_mes <- as.data.frame(TDF_mes)
# Frecuencias relativas
hi_mes <- (Tabla_mes$Freq / sum(Tabla_mes$Freq) * 100)
# Acumuladas
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 final
Tabla_mes_Final <- data.frame(
Mes = as.numeric(as.character(Tabla_mes$mes)), # NUMÉRICO, no factor
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)
)
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
# GRAFICO BARRAS
nombres_meses <- c("Enero","Febrero","Marzo","Abril","Mayo","Junio",
"Julio","Agosto","Septiembre","Octubre","Noviembre","Diciembre")
barplot(
Tabla_mes_Final$ni,
main = "Diagrama de barras: Gráfica de Distribución de meses",
xlab = "Meses del año",
ylab = "Cantidad",
col = "blue",
names.arg = nombres_meses,
ylim = c(0, max(Tabla_mes_Final$ni) * 1.1),
las = 2,
cex.names = 0.7
)
#DIAGRAMA DE CAJA
boxplot(mes,
horizontal=T,
col="darkblue",
main="Gráfica de Distribución de meses de meses en los que ocurre los derrames",
xlab = "Meses del año")
# OJIVAS ASCENDENTE
x_vals <- 1:12
ymax <- max(Tabla_mes_Final$Ni_asc) * 1.1
plot(x_vals, Tabla_mes_Final$Ni_asc,
type = "p",
pch = 19,
col = "blue",
xaxt = "n",
ylim = c(0, ymax),
main = "Gráfica de Ojiva ascendente de meses",
xlab = "Meses (1=Enero, 12=Diciembre)",
ylab = "Cantidad")
axis(1, at = 1:12, labels = 1:12, las = 2)
# OJIVA DESCENDENTE
x_ni_dsc <- 12:1
y_ni_dsc <- Tabla_mes_Final$`Ni dsc`
plot(x_ni_dsc,
y_ni_dsc,
type = "p",
main = "Gráfica de Ojivas descendentes de meses en los que ocurren los derrames",
ylab = "Cantidad",
xlab = "Meses del año",
col = "red",
pch = 19, # puntos sólidos
xaxt = "n")
axis(1, at = 12:1, labels = rev(Tabla_mes_Final$Mes))
# OJIVAS ASCENDENTE Y DESCENDENTE EN UNA SOLA GRAFICA
plot(x_vals, Tabla_mes_Final$Ni_asc,
type = "p",
main = "Gráfica de Ojivas de meses",
ylab = "Cantidad",
xlab = "Meses (1=Enero, 12=Diciembre)",
col = "blue",
xaxt = "n",
pch = 19)
axis(1, at = 1:12, labels = 1:12, las = 2) # 👈 solo números
points(x_vals, Tabla_mes_Final$Ni_dsc, col = "red", pch = 19)
legend("topright",
legend = c("Ascendente", "Descendente"),
col = c("blue", "red"),
pch = 19)
cat("\nCONCLUSIÓN:\n",
"En el caso de este variable se observa que los derrames manejan,\n",
"una freacuencia similar en todos los meses.\n")
##
## CONCLUSIÓN:
## En el caso de este variable se observa que los derrames manejan,
## una freacuencia similar en todos los meses.
# VARIABLE AÑO
ano <- as.numeric(df$ano)
## Warning: NAs introduced by coercion
ano <- na.omit(ano)
# Determinar el mínimo y máximo
min_ano <- min(ano)
max_ano <- max(ano)
breaks <- seq(min_ano, max_ano, by = 6)
if (max(breaks) < max_ano) {
breaks <- c(breaks, max_ano + 1)
}
labels_intervalos <- paste(breaks[-length(breaks)],
breaks[-1] - 1,
sep = "-")
ano_intervalos <- cut(ano,
breaks = breaks,
labels = labels_intervalos,
include.lowest = TRUE,
right = TRUE)
# TABLA DE FRECUENCIAS
TDF_ano <- table(ano_intervalos)
Tabla_ano <- as.data.frame(TDF_ano)
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)
)
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 7 0.20 8 0.23 3548 99.97
## 3 1969-1974 18 0.51 26 0.73 3541 99.77
## 4 1975-1980 34 0.96 60 1.69 3523 99.27
## 5 1981-1986 312 8.79 372 10.48 3489 98.31
## 6 1987-1992 334 9.41 706 19.89 3177 89.52
## 7 1993-1998 364 10.26 1070 30.15 2843 80.11
## 8 1999-2004 357 10.06 1427 40.21 2479 69.85
## 9 2005-2010 586 16.51 2013 56.72 2122 59.79
## 10 2011-2016 705 19.86 2718 76.58 1536 43.28
## 11 2017-2022 831 23.42 3549 100.00 831 23.42
# GRAFICO DE BARRAS
barplot(Tabla_ano_Final$ni,
names.arg = Tabla_ano_Final$Intervalo,
col = "blue",
main = "diagrama de barras: Gráfica de Distribución de derrames por intervalos de 6 años",
xlab = "Intervalos de años",
ylab = "Cantidad",
las = 2,
cex.names= 0.5
)
# BOXPLOT
boxplot(ano,
horizontal = TRUE,
col = "darkblue",
main = "Gráfica No.X: Distribución de años en los que ocurren los derrames",
xlab = "Años")
# OJIVA ASCENDENTE
x_vals <- 1:nrow(Tabla_ano_Final)
ymax <- max(Tabla_ano_Final$Ni_asc) * 1.1
plot(x_vals, Tabla_ano_Final$Ni_asc,
type = "p",
pch = 19,
col = "blue",
xaxt = "n",
ylim = c(0, ymax),
main = "Gráfica de Ojiva ascendente de intervalos de años",
xlab = "Intervalos de años",
ylab = "Cantidad")
axis(1, at = 1:nrow(Tabla_ano_Final),
labels = Tabla_ano_Final$Intervalo,
las = 2,
cex.axis = 0.5
)
# OJIVA DESCENDENTE
x_vals_dsc <- nrow(Tabla_ano_Final):1
plot(x_vals_dsc, Tabla_ano_Final$Ni_dsc,
type = "p",
pch = 19,
col = "red",
xaxt = "n",
ylim = c(0, ymax),
main = "Gráfica de Ojiva descendente de intervalos de años",
xlab = "Intervalos de años",
ylab = "Cantidad")
axis(1, at = nrow(Tabla_ano_Final):1,
labels = rev(Tabla_ano_Final$Intervalo),
las = 2,
cex.axis = 0.5
)
# OJIVAS ASC Y DSC EN UNA SOLA
plot(1:nrow(Tabla_ano_Final), Tabla_ano_Final$Ni_asc,
type = "p",
pch = 19,
col = "blue",
xaxt = "n",
ylim = c(0, ymax),
main = "Gráfica de Ojivas de intervalos de años",
xlab = "Intervalos de años",
ylab = "Cantidad")
axis(1, at = 1:nrow(Tabla_ano_Final),
labels = Tabla_ano_Final$Intervalo,
las = 2,
cex.axis = 0.5
)
points(1:nrow(Tabla_ano_Final), Tabla_ano_Final$Ni_dsc,
col = "red", pch = 19)
legend("topright",
legend = c("Ascendente", "Descendente"),
col = c("blue", "red"),
pch = 19)
cat("\nCONCLUSIÓN:\n",
"Analizando las graficas se puede determinar que los derrames han\n",
"ido aumentando con el paso de los años.\n")
##
## CONCLUSIÓN:
## Analizando las graficas se puede determinar que los derrames han
## ido aumentando con el paso de los años.
# VARIABLE "barreras_de_contencion_flotante"
barreras <- as.numeric(df$barreras_de_contencion_flotantes)
barreras <- na.omit(barreras)
# RANGO 1: 0 a 30
breaks_1 <- seq(0, 30, by = 2)
cut_1 <- cut(barreras[barreras >= 0 & barreras <= 30], breaks = breaks_1, right = TRUE, include.lowest = TRUE)
# Tabla de frecuencias
TDF_1 <- table(cut_1)
Tabla_1 <- as.data.frame(TDF_1)
# Frecuencias relativas
hi_1 <- (Tabla_1$Freq / sum(Tabla_1$Freq)) * 100
# Acumuladas
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
Tabla_Final_1 <- data.frame(
Intervalo = Tabla_1$cut_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] 1949 56.74 1949 56.74 3435 100.00
## 2 (2,4] 507 14.76 2456 71.50 1486 43.26
## 3 (4,6] 262 7.63 2718 79.13 979 28.50
## 4 (6,8] 267 7.77 2985 86.90 717 20.87
## 5 (8,10] 127 3.70 3112 90.60 450 13.10
## 6 (10,12] 86 2.50 3198 93.10 323 9.40
## 7 (12,14] 53 1.54 3251 94.64 237 6.90
## 8 (14,16] 32 0.93 3283 95.57 184 5.36
## 9 (16,18] 32 0.93 3315 96.51 152 4.43
## 10 (18,20] 26 0.76 3341 97.26 120 3.49
## 11 (20,22] 28 0.82 3369 98.08 94 2.74
## 12 (22,24] 14 0.41 3383 98.49 66 1.92
## 13 (24,26] 19 0.55 3402 99.04 52 1.51
## 14 (26,28] 14 0.41 3416 99.45 33 0.96
## 15 (28,30] 19 0.55 3435 100.00 19 0.55
# GRÁFICO DE BARRAS
barplot(Tabla_Final_1$ni,
names.arg = Tabla_Final_1$Intervalo,
col = "blue",
main = "Gráfica de Barras (0 a 30)",
xlab = "Intervalos",
ylab = "Cantidad",
las = 2,
cex.names = 0.7
)
# BOXPLOT
boxplot(barreras[barreras >= 0 & barreras <= 30],
horizontal = TRUE,
col = "darkblue",
main = "Boxplot de barreras (0 a 30)",
xlab = "Número de barreras")
# OJIVAS
x_vals_1 <- seq_along(Tabla_Final_1$Intervalo)
ymax_1 <- max(Tabla_Final_1$Ni_asc) * 1.1
# Ojiva ascendente
plot(x_vals_1, Tabla_Final_1$Ni_asc,
type = "p", pch = 19, col = "blue",
ylim = c(0, ymax_1),
xaxt = "n",
main = "Ojiva ascendente (0 a 30)",
xlab = "Intervalos", ylab = "Cantidad")
axis(1, at = x_vals_1, labels = Tabla_Final_1$Intervalo, las = 2,cex.axis = 0.7)
# Ojiva descendente
plot(x_vals_1, Tabla_Final_1$Ni_dsc,
type = "p", pch = 19, col = "red",
ylim = c(0, ymax_1),
xaxt = "n",
main = "Ojiva descendente (0 a 30)",
xlab = "Intervalos", ylab = "Cantidad")
axis(1, at = x_vals_1, labels = Tabla_Final_1$Intervalo, las = 2, cex.axis = 0.7)
# Ambas ojivas
plot(x_vals_1, Tabla_Final_1$Ni_asc,
type = "p", pch = 19, col = "blue",
ylim = c(0, ymax_1),
xaxt = "n",
main = "Ojivas (0 a 30)",
xlab = "Intervalos", ylab = "Cantidad")
points(x_vals_1, Tabla_Final_1$Ni_dsc, col = "red", 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"), pch = 19)
# RANGO 2: 31 a 380
breaks_2 <- seq(31, 380, by = 35)
cut_2 <- cut(barreras[barreras >= 31 & barreras <= 380], breaks = breaks_2, right = TRUE, include.lowest = TRUE)
# Tabla de frecuencias
TDF_2 <- table(cut_2)
Tabla_2 <- as.data.frame(TDF_2)
# Frecuencias relativas
hi_2 <- (Tabla_2$Freq / sum(Tabla_2$Freq)) * 100
# Acumuladas
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
Tabla_Final_2 <- data.frame(
Intervalo = 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 [31,66] 68 60.18 68 60.18 113 100.00
## 2 (66,101] 20 17.70 88 77.88 45 39.82
## 3 (101,136] 10 8.85 98 86.73 25 22.12
## 4 (136,171] 7 6.19 105 92.92 15 13.27
## 5 (171,206] 2 1.77 107 94.69 8 7.08
## 6 (206,241] 2 1.77 109 96.46 6 5.31
## 7 (241,276] 1 0.88 110 97.35 4 3.54
## 8 (276,311] 2 1.77 112 99.12 3 2.65
## 9 (311,346] 1 0.88 113 100.00 1 0.88
# GRÁFICO DE BARRAS
barplot(Tabla_Final_2$ni,
names.arg = Tabla_Final_2$Intervalo,
col = "blue",
main = "Gráfica de Barras (31 a 380)",
xlab = "Intervalos",
ylab = "Cantidad",
las = 2,
cex.names = 0.7
)
# BOXPLOT
boxplot(barreras[barreras >= 31 & barreras <= 380],
horizontal = TRUE,
col = "darkred",
main = "Boxplot de barreras (31 a 380)",
xlab = "Número de barreras")
# OJIVAS
x_vals_2 <- seq_along(Tabla_Final_2$Intervalo)
ymax_2 <- max(Tabla_Final_2$Ni_asc) * 1.1
# Ojiva ascendente
plot(x_vals_2, Tabla_Final_2$Ni_asc,
type = "p", pch = 19, col = "blue",
ylim = c(0, ymax_2),
xaxt = "n",
main = "Ojiva ascendente (31 a 380, ancho 35)",
xlab = "Intervalos", ylab = "Cantidad")
axis(1, at = x_vals_2, labels = Tabla_Final_2$Intervalo, las = 2,cex.axis = 0.6)
# Ojiva descendente
plot(x_vals_2, Tabla_Final_2$Ni_dsc,
type = "p", pch = 19, col = "red",
ylim = c(0, ymax_2),
xaxt = "n",
main = "Ojiva descendente (31 a 380)",
xlab = "Intervalos", ylab = "Cantidad")
axis(1, at = x_vals_2, labels = Tabla_Final_2$Intervalo, las = 2,cex.axis = 0.6)
# Ambas ojivas
plot(x_vals_2, Tabla_Final_2$Ni_asc,
type = "p", pch = 19, col = "blue",
ylim = c(0, ymax_2),
xaxt = "n",
main = "Ojivas (31 a 380, ancho 35)",
xlab = "Intervalos", ylab = "Cantidad")
points(x_vals_2, Tabla_Final_2$Ni_dsc, col = "red", pch = 19)
axis(1, at = x_vals_2, labels = Tabla_Final_2$Intervalo, las = 2, cex.axis = 0.6)
legend("topright", legend = c("Ascendente", "Descendente"), col = c("blue", "red"), pch = 19)
cat("\nCONCLUSIÓN:\n",
"Para esta variable se tomo la desición de separar en dos gráficas",
"ya que en la primera como se puede ver hay una gran afluencia en la",
"frecuencia del primer intervalo. Si se hubiera tomado como una sola",
"no se hubiera podido interpretar la gráfica.",
"Tomando en cuenta esto se podría decir que es es más frecuente que no",
"se use barreras para contener los derrames.")
##
## CONCLUSIÓN:
## Para esta variable se tomo la desición de separar en dos gráficas ya que en la primera como se puede ver hay una gran afluencia en la frecuencia del primer intervalo. Si se hubiera tomado como una sola no se hubiera podido interpretar la gráfica. Tomando en cuenta esto se podría decir que es es más frecuente que no se use barreras para contener los derrames.