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 Tabla de distribución de frecuencias mediante el teorema de Sturges
# Definir intervalos más pequeños (por ejemplo cada 5 grados)
min_lat <- floor(min(latitud, na.rm = TRUE)) - 0.001
max_lat <- ceiling(max(latitud, na.rm = TRUE)) + 0.001
# Secuencia de cortes cada 5 grados (puedes cambiar a 2.5 o 10 si quieres)
breaks_Latitud <- seq(min_lat, max_lat, by = 10)
# Asegurar que el último límite cubra el máximo
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)
# Porcentajes
hi_Latitud <- (tabla_Latitud$Freq / sum(tabla_Latitud$Freq)) * 100
tabla_Latitud$hi <- round(hi_Latitud, 2)
# Frecuencias acumuladas
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 final
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)
)
# Mostrar tabla
print(tabla_Latitud_Final)## Rango_Latitud Frecuencia Porcentaje Niasc Hiasc Nidsc Hidsc
## 1 [-78,-68) 1 3.57 1 3.57 28 100.00
## 2 [-68,-58) 0 0.00 1 3.57 27 96.43
## 3 [-58,-48) 1 3.57 2 7.14 27 96.43
## 4 [-48,-38) 0 0.00 2 7.14 26 92.86
## 5 [-38,-28) 1 3.57 3 10.71 26 92.86
## 6 [-28,-18) 0 0.00 3 10.71 25 89.29
## 7 [-18,-8) 0 0.00 3 10.71 25 89.29
## 8 [-8,2) 0 0.00 3 10.71 25 89.29
## 9 [2,12) 1 3.57 4 14.29 25 89.29
## 10 [12,22) 5 17.86 9 32.14 24 85.71
## 11 [22,32) 9 32.14 18 64.29 19 67.86
## 12 [32,42) 5 17.86 23 82.14 10 35.71
## 13 [42,52) 3 10.71 26 92.86 5 17.86
## 14 [52,61] 2 7.14 28 100.00 2 7.141.3.1 Histograma
h <- hist(latitud,
breaks = breaks_Latitud,
freq = TRUE,
main = "Gráfica N°1: Histograma de la Latitud de derrames Petroleros a Nivel Mundial",
cex.main = 0.8,
xlab = "Latitud (grados)",
ylab = "Frecuencia",
col = terrain.colors(length(breaks_Latitud) - 1),
border = "black",
las = 1,
xlim = c(min(breaks_Latitud), max(breaks_Latitud))) ## 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(
latitud,
horizontal = TRUE,
col = "beige",
main = "Gráfica N°2: Diagrama de Caja de la Latitud en Derrames Petroleros a Nivel Global",
cex.main = 0.8,
xlab = "Latitud (grados)"
)
1.3.3 Ojiva ascendente y descendente
# Calcular puntos medios de los intervalos
puntos_medios_Latitud <- (head(breaks_Latitud, -1) + tail(breaks_Latitud, -1)) / 2
# Frecuencias acumuladas
y_ni_asc_Latitud <- tabla_Latitud_Final$Niasc
y_ni_dsc_Latitud <- tabla_Latitud_Final$Nidsc
# Gráfica de ojivas
plot(puntos_medios_Latitud, y_ni_asc_Latitud,
type = "b",
main = "Gráfica N°3: Ojivas de la Latitud en Derrames Petroleros a Nivel Global",
cex.main = 0.8,
xlab = "Latitud (grados)",
ylab = "Frecuencia acumulada",
col = "black",
pch = 19)
lines(puntos_medios_Latitud, y_ni_dsc_Latitud,
col = "blue",
type = "b",
pch = 19)
grid()
legend("topleft",
legend = c("Ascendente", "Descendente"),
col = c("black", "blue"),
lty = 1,
pch = c(16, 17),
cex = 0.8,
inset = c(0.02, 0.29))
1.3.4 Indicadores estadísticos
Latitud_num <- latitud
library(e1071)
# Función para la moda
get_mode <- function(v) {
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
# Medidas de tendencia central
media <- mean(Latitud_num)
mediana <- median(Latitud_num)
moda <- get_mode(Latitud_num)
# Medidas de dispersión
desv <- sd(Latitud_num)
varianza <- var(Latitud_num)
cv <- (desv / media) * 100
# Medidas de forma
asim <- skewness(Latitud_num)
curt <- kurtosis(Latitud_num)
# Tabla final de indicadores
indicadores_Respuesta <- data.frame(
Indicador = c("Moda", "Mediana", "Media",
"Desviación Estándar", "Varianza",
"Coeficiente de Variación (%)",
"Asimetría", "Curtosis"),
Valor = round(c(moda, mediana, media,
desv, varianza, cv,
asim, 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
## Coeficiente de Variación (%) 135.60
## Asimetría -1.81
## Curtosis 2.971.4 Conclusión
Los derrames de petróleo se concentran principalmente entre las latitudes 10° y 40° en el hemisferio norte, lo que refleja mayor actividad petrolera en zonas tropicales y subtropicales. La mediana y la moda en 30° confirman esta concentración, mientras que la asimetría negativa indica un sesgo hacia latitudes menores. La alta dispersión evidencia una amplia variabilidad espacial, aunque con baja frecuencia en latitudes altas.
2 Longitud
2.1 Extraer la variable
## Warning: NAs introduced by coercion2.2 Tabla de distribución de frecuencias mediante el teorema de Sturges
# Número de datos
n <- length(longitud)
# Regla de Sturges
k <- round(1 + 3.322 * log10(n))
# Límites
min_long <- min(longitud)
max_long <- max(longitud)
# Amplitud
amplitud <- (max_long - min_long) / k
# Cortes
breaks_Longitud <- seq(min_long, max_long + amplitud, by = amplitud)
# Crear rangos
rango_Longitud <- cut(longitud,
breaks = breaks_Longitud,
right = FALSE,
include.lowest = TRUE)
# Tabla de frecuencias
TDF_Longitud <- table(rango_Longitud)
tabla_Longitud <- as.data.frame(TDF_Longitud)
# Porcentajes
tabla_Longitud$hi <- round((tabla_Longitud$Freq / sum(tabla_Longitud$Freq)) * 100, 2)
# Frecuencias acumuladas
tabla_Longitud$Niasc <- cumsum(tabla_Longitud$Freq)
tabla_Longitud$Hiasc <- round(cumsum(tabla_Longitud$hi), 2)
tabla_Longitud$Nidsc <- rev(cumsum(rev(tabla_Longitud$Freq)))
tabla_Longitud$Hidsc <- round(rev(cumsum(rev(tabla_Longitud$hi))), 2)
# Tabla final
tabla_Longitud_Final <- data.frame(
Rango_Longitud = tabla_Longitud$rango_Longitud,
Frecuencia = tabla_Longitud$Freq,
Porcentaje = tabla_Longitud$hi,
Niasc = tabla_Longitud$Niasc,
Hiasc = tabla_Longitud$Hiasc,
Nidsc = tabla_Longitud$Nidsc,
Hidsc = tabla_Longitud$Hidsc
)
print(tabla_Longitud_Final)## Rango_Longitud Frecuencia Porcentaje Niasc Hiasc Nidsc Hidsc
## 1 [-174,-118) 12 26.67 12 26.67 45 100.00
## 2 [-118,-61) 27 60.00 39 86.67 33 73.33
## 3 [-61,-4.5) 1 2.22 40 88.89 6 13.33
## 4 [-4.5,52) 4 8.89 44 97.78 5 11.11
## 5 [52,108) 0 0.00 44 97.78 1 2.22
## 6 [108,165) 0 0.00 44 97.78 1 2.22
## 7 [165,222] 1 2.22 45 100.00 1 2.222.3 Gráficos
2.3.1 Histograma
h <- hist(longitud,
breaks = breaks_Longitud,
freq = TRUE,
main = "Gráfica N°1: Histograma de la Longitud de derrames Petroleros a Nivel Mundial",
xlab = "Longitud (grados)",
ylab = "Frecuencia",
col = terrain.colors(length(breaks_Longitud) - 1),
border = "black",
las = 1,
xlim = c(min(breaks_Longitud), max(breaks_Longitud)))
2.3.2 Diagrama de cajas
# Límites inferiores y superiores (a partir de los cortes ya creados)
lim_inf_Longitud <- breaks_Longitud[-length(breaks_Longitud)]
lim_sup_Longitud <- breaks_Longitud[-1]
# Ojiva ascendente (límite superior)
plot(lim_sup_Longitud,
tabla_Longitud_Final$Niasc,
type = "o",
pch = 19,
main = "Gráfica N°3: Ojivas de la Longitud en Derrames Petroleros a Nivel Global",
cex.main = 0.8,
xlab = "Longitud (grados)",
ylab = "Frecuencia acumulada",
col = "black",
ylim = c(0, max(tabla_Longitud_Final$Niasc)))
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
library(e1071)
# Función moda
get_mode <- function(v) {
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
media <- mean(longitud)
mediana <- median(longitud)
moda <- get_mode(longitud)
desv <- sd(longitud)
varianza <- var(longitud)
cv <- (desv / media) * 100
asim <- skewness(longitud)
curt <- kurtosis(longitud)
indicadores_Respuesta <- data.frame(
Indicador = c("Moda", "Mediana", "Media",
"Desviación Estándar", "Varianza",
"Coeficiente de Variación (%)",
"Asimetría", "Curtosis"),
Valor = round(c(moda, mediana, media,
desv, varianza, cv,
asim, 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
## Coeficiente de Variación (%) -74.47
## Asimetría 1.66
## Curtosis 4.352.5 Conclusión
Los derrames de petróleo se concentran principalmente entre las longitudes -120° y -60° del hemisferio occidental, especialmente en el continente americano y el océano Atlántico. La media, mediana y moda confirman esta concentración, mientras que la asimetría positiva indica valores extremos hacia longitudes mayores y la alta desviación estándar refleja una amplia dispersión, aunque con clara predominancia en zonas americanas.
3 Maxima Liberación de petróleo
3.1 Extraer la variable
# Asegurar que la variable sea numérica y sin NA
datos$Maximo_liberacion_galones <- as.numeric(as.character(datos$Maximo_liberacion_galones))
Maximo_liberacion_galones <- na.omit(datos$Maximo_liberacion_galones)###Rango de mayor frecuencia y presencia de pocos valores atípicos
# Definir rango fijo
rango_min <- 0
rango_max <- 40000
# Filtrar datos dentro del rango
x_rango1 <- Maximo_liberacion_galones[
Maximo_liberacion_galones >= rango_min &
Maximo_liberacion_galones <= rango_max
]###Tabla de distribución de frecuencias mediante el teorema de Sturges
n <- length(x_rango1)
k <- round(1 + 3.322 * log10(n))
amplitud <- (rango_max - rango_min) / k
# Intervalos según Sturges en 0-40000
breaks_1 <- seq(rango_min, rango_max, by = amplitud)
breaks_1[length(breaks_1)] <- rango_max
# TABLA DE FRECUENCIAS
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
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 = ","),
" - ",
format(round(as.numeric(x[2]), 0), big.mark = ",")
)
})
# 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)
)
print(Tabla_Final_1)## Intervalo ni hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1 0 - 3,330 1076 64.32 1076 64.32 1673 100.00
## 2 3,330 - 6,670 226 13.51 1302 77.82 597 35.68
## 3 6,670 - 10,000 123 7.35 1425 85.18 371 22.18
## 4 10,000 - 13,300 51 3.05 1476 88.22 248 14.82
## 5 13,300 - 16,700 37 2.21 1513 90.44 197 11.78
## 6 16,700 - 20,000 41 2.45 1554 92.89 160 9.56
## 7 20,000 - 23,300 20 1.20 1574 94.08 119 7.11
## 8 23,300 - 26,700 29 1.73 1603 95.82 99 5.92
## 9 26,700 - 30,000 23 1.37 1626 97.19 70 4.18
## 10 30,000 - 33,300 13 0.78 1639 97.97 47 2.81
## 11 33,300 - 36,700 21 1.26 1660 99.22 34 2.03
## 12 36,700 - 40,000 13 0.78 1673 100.00 13 0.783.1.1 Histograma
h <- hist(
x_rango1,
breaks = breaks_1,
freq = TRUE,
main = "Histograma del Máximo de Liberación Petrolera (Sturges 0-40000)",
xlab = "Máximo de liberación (galones)",
ylab = "Frecuencia",
col = terrain.colors(length(breaks_1) - 1),
border = "black"
)
3.1.2 Diagrama de caja
# Límites de clase
lim_inf <- breaks_1[-length(breaks_1)]
lim_sup <- breaks_1[-1]
# Puntos medios ponderados
puntos_medios <- (lim_inf + lim_sup) / 2
datos_agrupados <- rep(puntos_medios, Tabla_Final_1$ni)
boxplot(
datos_agrupados,
horizontal = TRUE,
col = "beige",
main = "Diagrama de Caja (según Sturges 0-40000)",
xlab = "Máximo de liberación (galones)"
)
3.1.3 Ojiva ascendente y descendente
options(scipen = 999)
x_vals_1 <- seq_along(Tabla_Final_1$Intervalo)
# Usar la descendente correcta
N_total <- sum(Tabla_Final_1$ni)
Ni_dsc_correcta <- N_total - Tabla_Final_1$Ni_asc + Tabla_Final_1$ni
ymax_1 <- max(Tabla_Final_1$Ni_asc, Ni_dsc_correcta) * 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 (CORRECTAS)
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 Máxima Liberación Petrolera (Rango 1)",
xlab = "Máximo de liberación (galones)",
ylab = "Frecuencia acumulada")
lines(x_vals_1, Ni_dsc_correcta,
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.2 Indicadores estadísticos
##
## Attaching package: 'moments'## The following objects are masked from 'package:e1071':
##
## kurtosis, moment, skewnessMax_lib <- as.numeric(datos$Maximo_liberacion_galones)
Max_lib <- Max_lib[!is.na(Max_lib)]
# Filtrar SOLO rango 1
Max_lib_rango1 <- Max_lib[Max_lib >= 0 & Max_lib <= 40000]
# Medidas de tendencia central
media <- mean(Max_lib_rango1)
mediana <- median(Max_lib_rango1)
# Medidas de dispersión
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("Mediana", "Media", "Desviación Estándar",
"Varianza", "Coef. de Variación (%)",
"Asimetría", "Curtosis"),
Valor = c(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
## Mediana 1470.00
## Media 5032.38
## Desviación Estándar 8058.40
## Varianza 64937830.94
## Coef. de Variación (%) 160.13
## Asimetría 2.33
## Curtosis 8.043.3 Conclusión
Los derrames de petróleo en el Rango 1 (0 – 40 000 galones) se concentran principalmente en volúmenes bajos, lo que se refleja en una mediana de 1 470 galones. La media de 5 032 galones, mayor que la mediana, y la asimetría positiva (2.33) evidencian la presencia de algunos derrames de mayor magnitud que sesgan la distribución hacia la derecha, mientras que la curtosis elevada (8.04) indica una fuerte concentración de eventos pequeños con pocos casos extremos.
4 Respuesta actual
4.1 Extraer la variable
# Asegurar que la variable sea numérica y sin NA
Resp_actual <- as.numeric(datos$Respuesta_actual_galones)## Warning: NAs introduced by coercion###Rango de mayor frecuencia y presencia de pocos valores atípicos
###Tabla de distribución de frecuencias mediante el teorema de Sturges
n <- length(Resp_actual_rango1)
k <- round(1 + 3.322 * log10(n)) # número de clases
R <- max(Resp_actual_rango1) - min(Resp_actual_rango1)
A <- R / k # amplitud
breaks_sturges <- seq(min(Resp_actual_rango1),
max(Resp_actual_rango1),
by = A)
if (max(breaks_sturges) < max(Resp_actual_rango1)) {
breaks_sturges <- c(breaks_sturges, max(Resp_actual_rango1))
}
# ============================
# 3. Tabla de frecuencias
# ============================
cut_s <- cut(Resp_actual_rango1, breaks = breaks_sturges,
right = TRUE, include.lowest = TRUE)
TDF <- table(cut_s)
Tabla <- as.data.frame(TDF)
hi <- (Tabla$Freq / sum(Tabla$Freq)) * 100
Ni_asc <- cumsum(Tabla$Freq)
Hi_asc <- cumsum(hi)
Ni_dsc <- rev(cumsum(rev(Tabla$Freq)))
Hi_dsc <- rev(cumsum(rev(hi)))
intervalos_num <- gsub("\\[|\\]|\\(|\\)", "", as.character(Tabla$cut_s))
intervalos_partes <- strsplit(intervalos_num, ",")
etiquetas <- sapply(intervalos_partes, function(x) {
paste0(round(as.numeric(x[1])), " - ", round(as.numeric(x[2])))
})
Tabla_Final <- data.frame(
Intervalo = etiquetas,
ni = Tabla$Freq,
hi = round(hi, 2),
Ni_asc = Ni_asc,
Hi_asc = round(Hi_asc, 2),
Ni_dsc = Ni_dsc,
Hi_dsc = round(Hi_dsc, 2)
)
print(Tabla_Final)## Intervalo ni hi Ni_asc Hi_asc Ni_dsc Hi_dsc
## 1 0 - 3330 1134 74.90 1134 74.90 1514 100.00
## 2 3330 - 6670 138 9.11 1272 84.02 380 25.10
## 3 6670 - 10000 81 5.35 1353 89.37 242 15.98
## 4 10000 - 13300 37 2.44 1390 91.81 161 10.63
## 5 13300 - 16700 22 1.45 1412 93.26 124 8.19
## 6 16700 - 20000 23 1.52 1435 94.78 102 6.74
## 7 20000 - 23300 11 0.73 1446 95.51 79 5.22
## 8 23300 - 26700 21 1.39 1467 96.90 68 4.49
## 9 26700 - 30000 20 1.32 1487 98.22 47 3.10
## 10 30000 - 33300 5 0.33 1492 98.55 27 1.78
## 11 33300 - 36700 12 0.79 1504 99.34 22 1.45
## 12 36700 - 40000 10 0.66 1514 100.00 10 0.664.1.1 Histograma
## null device
## 14.1.2 Diagrama de caja
boxplot(
Resp_actual_rango1,
horizontal = TRUE,
col = "purple2",
main = "Boxplot (Sturges)",
xlab = "Cantidad recolectada",
xaxt = "n"
)
axis(1, cex.axis = 0.6)
4.1.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)
4.2 Indicadores estadísticos
library(e1071)
# Asegurar que sea numérico y sin NA (mismo vector de la tabla)
Resp_actual_rango1 <- as.numeric(Resp_actual_rango1)
Resp_actual_rango1 <- na.omit(Resp_actual_rango1)
# Función moda
get_mode <- function(v) {
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
# Medidas
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
asim <- skewness(Resp_actual_rango1)
curt <- kurtosis(Resp_actual_rango1)
# Tabla final de indicadores
Indicadores <- data.frame(
Indicador = c("Moda", "Mediana", "Media", "Desviación estándar",
"Varianza", "Coef. de Variación (%)",
"Asimetría", "Curtosis"),
Valor = round(c(moda, mediana, media, desv,
varianza, cv, asim, curt), 2)
)
print("Indicadores estadísticos (Sturges, Rango 1: 0–40 000 galones)")## [1] "Indicadores estadísticos (Sturges, 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.88
## Curtosis 11.324.3 Conclusión
La variable Cantidad recolectada de los derrames en el Rango 1 (0–40 000 galones) se concentra principalmente en valores bajos, con una mediana de 500 galones y una media de 3 599 galones. La asimetría positiva (2.87) indica la presencia de algunos eventos de mayor magnitud que sesgan la distribución hacia la derecha, mientras que la curtosis elevada (8.31) refleja una alta concentración de derrames pequeños con pocos casos extremos. En conjunto, estos resultados evidencian que la mayoría de los derrames implican volúmenes reducidos de recolección.