Modelo Potencial:Relación entre Liberación no intencional (barriles) y costo del producto perdido
Brandon
1 Justificación de las dos variables
La selección del volumen de liberación no intencional (X) como variable independiente y el costo del producto perdido (Y) como variable dependiente se justifica por su innegable relación directa de causa y efecto: la magnitud física del derrame es el detonante absoluto que define el valor económico del recurso desperdiciado. A diferencia de los gastos totales (que incluyen factores altamente ruidosos e impredecibles como demandas legales o remediación ambiental de terceros), el costo del producto perdido responde fielmente a la cantidad de volumen derramado.
2 Cargar datos
En esta primera sección, estableceremos los cimientos de nuestro análisis importando la base de datos original a nuestro entorno de trabajo en R. Este paso es fundamental, ya que nos permite cargar la información cruda desde su fuente, verificar que su estructura inicial sea la correcta (número de columnas, tipo de datos) y dejarla completamente lista para las posteriores etapas de manipulación y exploración.
library(readr)
database <- read_csv("database-_1_.csv")## Warning: One or more parsing issues, call `problems()` on your data frame for details,
## e.g.:
## dat <- vroom(...)
## problems(dat)## Rows: 2795 Columns: 36
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (18): Accident Date/Time, Operator Name, Pipeline/Facility Name, Pipelin...
## dbl (18): Report Number, Supplemental Number, Accident Year, Operator ID, Ac...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.3 Extraer las dos variables
Una vez cargada la base completa, procederemos a aislar y seleccionar únicamente las dos variables específicas que protagonizarán nuestro estudio. Identificaremos claramente cuál actuará como nuestra variable independiente (o predictora, denotada como X) y cuál será nuestra variable dependiente (o de respuesta, denotada como Y), simplificando así el conjunto de datos para enfocar nuestro análisis sin distracciones.
df_lin <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Lost Commodity Costs`
)3.1 Limpieza y filtro
La confiabilidad de cualquier modelo estadístico depende directamente de la calidad de los datos ingresados. Por ello, en esta etapa realizaremos un proceso riguroso de limpieza y filtrado. Nos encargaremos de eliminar los valores perdidos (NAs) que puedan generar errores de cálculo y aplicaremos restricciones de rango para descartar valores atípicos (outliers) extremos, garantizando que nuestra información represente fielmente la tendencia general.
df_lin <- na.omit(df_lin)
df_lin <- df_lin[df_lin$X > 0 & df_lin$X < 5000, ]
df_lin <- df_lin[df_lin$Y > 0, ]4 Conteo de las dos variables
Una vez concluida la fase de depuración y filtrado, resulta indispensable conocer el tamaño exacto de nuestra muestra final. Determinar el número de observaciones útiles no es un mero formalismo; este conteo nos indicará el volumen de datos con el que construiremos nuestro modelo, lo cual impacta directamente en la significancia, el margen de error y el poder estadístico de nuestros futuros resultados. A continuación, verificaremos la cantidad total de registros (pares de variables X e Y) que han superado nuestros estrictos criterios de calidad y se encuentran listos para el análisis cuantitativo.
# 1. Conteo total de registros (pares de X e Y)
total_registros <- nrow(df_lin)
# Imprimir el resultado del conteo
cat("La cantidad total de registros útiles para el modelo es de:", total_registros, "\n\n")## La cantidad total de registros útiles para el modelo es de: 2298# 2. (Opcional) Mostrar un resumen estadístico de las dos variables
# para confirmar que los filtros de rango se aplicaron correctamente:
summary(df_lin)## X Y
## Min. : 0.01 Min. : 1.0
## 1st Qu.: 0.55 1st Qu.: 50.0
## Median : 2.90 Median : 181.5
## Mean : 112.01 Mean : 7495.8
## 3rd Qu.: 20.00 3rd Qu.: 1000.0
## Max. :4950.00 Max. :1092448.05 Tabla de pares de valores
# Asegúrate de tener instalada y cargada la librería DT
library(DT)## Warning: package 'DT' was built under R version 4.5.3# Generamos la tabla interactiva con nuestra base limpia df_lin
datatable(df_lin,
colnames = c("Barriles Liberados (X)", "Costos Totales USD (Y)"),
caption = "Vista interactiva de los registros listos para el análisis.",
options = list(
pageLength = 10, # Muestra 10 registros por página
autoWidth = TRUE, # Ajusta el ancho de las columnas automáticamente
searchHighlight = TRUE # Resalta el texto si usas el buscador de la tabla
))6 Gráficas
6.1 Gráfica de nube de puntos
Antes de realizar cualquier cálculo matemático complejo, es imprescindible realizar una inspección visual de nuestro fenómeno. Aquí construiremos un diagrama de dispersión (scatter plot) utilizando nuestros datos limpios correspondientes a los Barriles Liberados (\(X\)) y el Costo del Producto Perdido (\(Y\)). Esta gráfica nos permitirá observar de manera intuitiva cómo se distribuyen los puntos en un plano cartesiano, revelando a simple vista la dispersión general y dándonos los primeros indicios visuales de que la correlación entre ambas variables no sigue una línea recta, sino que insinúa una trayectoria curva típica de un crecimiento acelerado.
# 1. Extraemos las variables originales
df_lin <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Lost Commodity Costs`
)
# 2. Limpieza básica
df_lin <- na.omit(df_lin)
df_lin <- df_lin[df_lin$X > 0 & df_lin$X < 5000, ]
df_lin <- df_lin[df_lin$Y > 0, ]
df_lin <- df_lin[df_lin$Y < (df_lin$X * 100 + 50000), ]
# 3. Limpieza básica
plot(df_lin$X, df_lin$Y,
main="Gráfica N° 2: Nube de Puntos",
xlab="Barriles Liberados",
ylab="Costo del Producto Perdido (USD)",
pch=16,
col=rgb(0.2, 0.4, 0.8, 0.6),
xlim=c(0, 5000),
ylim=c(0, 500000))
6.2 Conjetura del modelo
A partir de la observación de la gráfica anterior, formulamos una hipótesis sobre el comportamiento matemático del fenómeno. Al notar que el valor monetario de las pérdidas escala de forma multiplicativa a medida que aumenta el volumen del derrame, justificamos la elección de un modelo potencial por encima de una simple relación lineal básica.Se conjetura un modelo potencial: El costo del producto perdido (\(Y\)) presenta un crecimiento proporcional a una potencia de los barriles liberados (\(X\)), indicando que los costos se multiplican a medida que la magnitud del derrame escala.
\[Y=a\cdot X^b\]
Este modelo es ideal para representar costos que crecen de forma no lineal ante desastres ambientales. CALCULAR PARÁMETROS (LOGARITMO X Y LOGARITMO Y) Procedemos a la linealización mediante logaritmos neperianos para obtener los parámetros mediante el método de mínimos cuadrados.
# Calculamos el modelo matemático
modelo_potencial <- lm(log(Y) ~ log(X), data = df_lin)
# Extraemos Alpha (revirtiendo el logaritmo con exp) y Beta
alpha_a <- exp(coef(modelo_potencial)[1])
beta_b <- coef(modelo_potencial)[2]
# Imprimimos el texto final en el reporte
cat("Resultados de los Parámetros:\n")## Resultados de los Parámetros:cat("Para el modelo ajustado, se han obtenido los siguientes valores fundamentales:\n")## Para el modelo ajustado, se han obtenido los siguientes valores fundamentales:cat(sprintf("Parámetro Alpha (a): %s\n", formatC(alpha_a, format="f", digits=2, big.mark=",")))## Parámetro Alpha (a): 83.63cat(sprintf("Parámetro Beta (b): %.2f\n", beta_b))## Parámetro Beta (b): 0.806.3 Gráfica de modelo
Para validar nuestro cálculo, superponemos la curva teórica generada por nuestra ecuación matemática sobre la nube de puntos reales. Esta representación visual cruzada es la forma más directa de demostrar qué tan bien se adapta nuestro modelo a la realidad histórica de los derrames registrados.R
# 1. Extraemos las variables originales
df_lin <- data.frame(
X = database$`Unintentional Release (Barrels)`,
Y = database$`Lost Commodity Costs`
)
# 2. Limpieza y Filtro de Outliers
df_lin <- na.omit(df_lin)
df_lin <- df_lin[df_lin$X > 0 & df_lin$X < 5000, ]
df_lin <- df_lin[df_lin$Y > 0, ]
df_lin <- df_lin[df_lin$Y < (df_lin$X * 100 + 50000), ]
# 3. Gráfica base (Nube de Puntos)
plot(df_lin$X, df_lin$Y,
main="Gráfica N° 2: Ajuste con Fórmula Potencial",
xlab="Barriles Liberados",
ylab="Costo del Producto Perdido (USD)",
pch=16,
col=rgb(0.2, 0.4, 0.8, 0.6),
xlim=c(0, 5000),
ylim=c(0, 500000))
modelo_potencial <- lm(log(Y) ~ log(X), data = df_lin)
# Extraemos 'a' y 'b' para la fórmula
a <- exp(coef(modelo_potencial)[1])
b <- coef(modelo_potencial)[2]
# Aplicamos la FÓRMULA POTENCIAL
x_curva <- seq(min(df_lin$X), max(df_lin$X), length.out = 1000)
y_curva <- a * (x_curva ^ b)
# Añadimos la curva roja al gráfico basándonos en la fórmula
lines(x_curva, y_curva, col="red", lwd=3)
7 Test de bondad del modelo
Más allá de la apreciación visual, necesitamos una métrica cuantitativa robusta para evaluar nuestra conjetura. Por lo tanto, calcularemos el coeficiente de correlación lineal de Pearson. Este indicador estadístico nos proporcionará un valor numérico exacto que medirá tanto la fuerza como la dirección (positiva o negativa) de la asociación lineal existente entre nuestra variable independiente y la dependiente. Al ser variables proporcionales, el coeficiente será naturalmente alto.
7.1 Coeficiente de correlación de Pearson
## Coeficiente de Pearson (R): 0.87467.2 Coeficiente de Determinación
## Coeficiente de Determinación (R²): 0.7657.3 La ecuación del modelo
## La ecuación del modelo potencial es: Y = 83.63 * X ^ 0.8041## Interpretación: La relación es de tipo elástica/multiplicativa. Por cada 1% que aumentan los barriles derramados, el costo del producto perdido no crece de forma plana, sino que se incrementa en un 80.41 %.| Variable | Tipo | Pearson (R) | R² | Parámetro a | Parámetro b | Ecuación |
|---|---|---|---|---|---|---|
| Liberación no intencional (Barriles) | Independiente (x) | |||||
| Costo del Producto Perdido (USD) | Dependiente (y) | 0.8746 | 0.765 | 83.63 | 0.8041 | y = 83.63 * x^0.8041 |
| Autor: Brandon |
8 Estimación
La verdadera utilidad de un modelo de regresión radica en su capacidad predictiva. En esta sección, pondremos a prueba nuestro modelo utilizando la ecuación matemática previamente definida (\(Y = a \cdot X^b\)) para realizar estimaciones. Calcularemos el valor esperado de la variable de respuesta (\(Y\)) dados nuevos valores hipotéticos de la variable predictora (\(X\)) que no necesariamente estaban incluidos en nuestra muestra original.
Ejemplo:
Supongamos un incidente donde se liberan 2,500 barriles, ¿cuál es el costo estimado del producto perdido?
# Supongamos un incidente donde se liberan 2,500 barriles
val_x <- 2500
# Calculamos la predicción usando la fórmula de nuestro modelo potencial (Y = a * X^b)
# Nota: Asumimos que param_a y param_b ya fueron calculados en el bloque de la sección 7
prediccion_y <- param_a * (val_x ^ param_b)
# Le damos formato de moneda para que se lea mejor en el reporte (ej. 1,500,230.50)
costo_formateado <- formatC(prediccion_y, format = "f", digits = 2, big.mark = ",")
# Imprimimos los resultados en consola
cat("\n--- ESTIMACIÓN ---\n")##
## --- ESTIMACIÓN ---cat("Para un derrame de", val_x, "barriles, se estima un costo de producto perdido de: $", costo_formateado, " USD.\n")## Para un derrame de 2500 barriles, se estima un costo de producto perdido de: $ 45,153.52 USD.9 Conclusión
Entre los Barriles Liberados y el Costo del Producto Perdido existe una relación de tipo potencial cuya ecuación matemática está representada por y = 83.63 * x^0.80, siendo ‘x’ los Barriles Liberados y ‘y’ el Costo del Producto Perdido en USD. El modelo estimado muestra que la relación es multiplicativa, por lo que, por cada 1% que aumentan los Barriles Liberados, el Costo del Producto Perdido se incrementa en aproximadamente un 0.80%. El parámetro inicial (83.63) representa el costo base estimado que ancla la curva al inicio del derrame, y su presencia mejora el ajuste estadístico del modelo. El R² ≈ 76.5% indica un buen nivel de explicación de los datos. Finalmente, el modelo permite realizar una estimación técnica donde, para un incidente con una liberación de 2,500 barriles, se proyecta una pérdida económica en producto de 45,153.52 USD, confirmando una correlación sólida con un coeficiente de Pearson de 0.8746.