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