IDENTIFICACION Y JUSTIFICACIÓN DE LA VARIABLE

Costos Totales se definen como una variable cuantitativa continua, ya que se expresan mediante valores numéricos reales que pueden adoptar cualquier cifra decimal dentro de un intervalo determinado. Esta continuidad permite medir con precisión la magnitud económica de cada incidente, reflejando los costos totales excatos.”

CARGAR DATOS

Importamos el archivo “database (1).csv” desde una ruta local y lo almacena en el objeto datos, usando espacios o tabulaciones como separador.

# Importación de datos

## setwd("C:/Users/ronal/OneDrive/Desktop")

datos <- read.csv("database (1).csv", header = TRUE, sep = ",", dec = ".")

EXTRAER LA VARIABLE

Extraemos la variable costos totales, omitimos las celdas en blanco o valores iguales a cero y verificamos el tamaño muestral

All.Costs <- na.omit(datos$All.Costs)
All.Costs <- All.Costs[All.Costs > 0]
n_total <- length(All.Costs)

TABLA DE FRECUENCIA

En la tabla de distribución de frecuencias de la variable costos totales en el que el número de clases se determinó mediante la regla de Sturges y el ancho de clase se calculó a partir del rango total de los datos.

xmin <- min(All.Costs)
xmax <- max(All.Costs)
R <- xmax - xmin

# Regla de Sturges para determinar K

K <- floor(1 + 3.3 * log10(length(All.Costs)))

# Amplitud de los intervalos

A <- R / K

# Definición de Límites y Marcas de Clase (MC)

Li <- round(seq(from = xmin, to = xmax - A, by = A), 2)
Ls <- round(seq(from = xmin + A, to = xmax, by = A), 2)
MC <- round((Li + Ls) / 2)

# Cfrecuencias (ni)

ni <- numeric(K)
for (i in 1:(K-1)) {
  ni[i] <- sum(All.Costs >= Li[i] & All.Costs < Ls[i])
}
ni[K] <- sum(All.Costs >= Li[K] & All.Costs <= xmax)

# Cálculo de frecuencias relativas y acumuladas

hi <- ni / sum(ni) * 100
Ni_asc <- cumsum(ni)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_asc <- cumsum(hi)
Hi_desc <- rev(cumsum(rev(hi)))

# Creación del Data Frame final

TDF <- data.frame(
  Li, Ls, MC, ni, 
  hi_porc = round(hi, 2), 
  Ni_asc, Ni_desc, 
  Hi_asc_porc = round(Hi_asc, 2), 
  Hi_desc_porc = round(Hi_desc, 2)
)

knitr::kable(TDF, 
             caption = "Tabla No. 1: Distribución de Frecuencias de Costos Totales ",
             col.names = c("Lím. Inf.", "Lím. Sup.", "Marca Clase", "ni", "hi (%)", "Ni Asc.", "Ni Desc.", "Hi Asc. (%)", "Hi Desc. (%)"),
             digits = 2)

Tabla No. 1: Distribución de Frecuencias de Costos Totales
Lím. Inf.	Lím. Sup.	Marca Clase	ni	hi (%)	Ni Asc.	Ni Desc.	Hi Asc. (%)	Hi Desc. (%)
1	70043844	35021923	2757	99.86	2757	2761	99.86	100.00
70043844	140087687	105065766	2	0.07	2759	4	99.93	0.14
140087687	210131530	175109609	1	0.04	2760	2	99.96	0.07
210131530	280175373	245153452	0	0.00	2760	1	99.96	0.04
280175373	350219216	315197295	0	0.00	2760	1	99.96	0.04
350219216	420263060	385241138	0	0.00	2760	1	99.96	0.04
420263060	490306903	455284981	0	0.00	2760	1	99.96	0.04
490306903	560350746	525328824	0	0.00	2760	1	99.96	0.04
560350746	630394589	595372667	0	0.00	2760	1	99.96	0.04
630394589	700438432	665416510	0	0.00	2760	1	99.96	0.04
700438432	770482275	735460353	0	0.00	2760	1	99.96	0.04
770482275	840526118	805504196	1	0.04	2761	1	100.00	0.04

NUEVA TABLA DE DISTRIBUCIÓN DE FRECUENCIA

Se seleccionó el primer intervalo de la variable costos totales para el análisis, debido a que en este se concentra el 90% de los datos. Esta elección permite construir la tabla de frecuencia, gráficas más claras y legibles, facilitando la interpretación de la distribución de los datos y evitando distorsiones visuales provocadas por intervalos con baja frecuencia.

umbral_90 <- quantile(All.Costs, 0.90)
datos_zoom <- All.Costs[All.Costs <= umbral_90]

n_z <- length(datos_zoom)
xmin_z <- min(datos_zoom)
xmax_z <- max(datos_zoom)

#  Regla de Sturges (K)

K_z <- floor(1 + 3.322 * log10(n_z))
R_z <- xmax_z - xmin_z
A_z <- R_z / K_z

# Creación de cortes e intervalos

cortes_z <- seq(xmin_z, xmin_z + (K_z * A_z), length.out = K_z + 1)
Li_z <- cortes_z[1:K_z]
Ls_z <- cortes_z[2:(K_z + 1)]
MC_z <- (Li_z + Ls_z) / 2

# Cálculo de Frecuencias

ni_z <- as.vector(table(cut(datos_zoom, breaks = cortes_z, include.lowest = TRUE)))
hi_z <- (ni_z / n_z) * 100

Ni_asc_z  <- cumsum(ni_z)
Ni_desc_z <- rev(cumsum(rev(ni_z)))
Hi_asc_z  <- cumsum(hi_z)
Hi_desc_z <- rev(cumsum(rev(hi_z)))

#  Estructuración

TDF_final_zoom <- data.frame(
  Li      = round(Li_z, 2),
  Ls      = round(Ls_z, 2),
  MC      = round(MC_z, 2),
  ni      = ni_z,
  hi_porc = round(hi_z, 2),
  Ni_asc  = Ni_asc_z,
  Ni_desc = Ni_desc_z,
  Hi_asc  = round(Hi_asc_z, 2),
  Hi_desc = round(Hi_desc_z, 2)
)

knitr::kable(TDF_final_zoom, 
             caption = "Tabla No. 2: Distribución de Frecuencias de Costos Totales",
             align = 'c',
             col.names = c("Lím. Inf.", "Lím. Sup.", "Marca Clase", "ni", "hi (%)", 
                           "Ni Asc.", "Ni Desc.", "Hi Asc. (%)", "Hi Desc. (%)"))

Tabla No. 2: Distribución de Frecuencias de Costos Totales
Lím. Inf.	Lím. Sup.	Marca Clase	ni	hi (%)	Ni Asc.	Ni Desc.	Hi Asc. (%)	Hi Desc. (%)
1.00	43809.25	21905.12	1695	68.21	1695	2485	68.21	100.00
43809.25	87617.50	65713.38	286	11.51	1981	790	79.72	31.79
87617.50	131425.75	109521.62	120	4.83	2101	504	84.55	20.28
131425.75	175234.00	153329.88	103	4.14	2204	384	88.69	15.45
175234.00	219042.25	197138.12	68	2.74	2272	281	91.43	11.31
219042.25	262850.50	240946.38	50	2.01	2322	213	93.44	8.57
262850.50	306658.75	284754.62	44	1.77	2366	163	95.21	6.56
306658.75	350467.00	328562.88	23	0.93	2389	119	96.14	4.79
350467.00	394275.25	372371.12	31	1.25	2420	96	97.38	3.86
394275.25	438083.50	416179.38	24	0.97	2444	65	98.35	2.62
438083.50	481891.75	459987.62	15	0.60	2459	41	98.95	1.65
481891.75	525700.00	503795.88	26	1.05	2485	26	100.00	1.05

GRÁFICAS

Una vez generada la Tabla de Distribución de Frecuencias, procedemos a visualizar los datos. Esta gráfica es fundamental para identificar la asimetría de la variable continua de costos y justificar el uso de modelos probabilísticos posteriores.

ggplot(TDF_final_zoom, aes(x = MC, y = hi_porc)) +
  
  geom_bar(stat = "identity", 
           fill = "steelblue", 
           color = "black", 
           alpha = 0.8,
           width = A_z) + 

  # Configuración del eje X con los límites de clase (Li y el último Ls)
  
  scale_x_continuous(breaks = c(Li_z, Ls_z[K_z]), 
                     labels = scales::comma) +
  
  # Configuración del eje Y con formato de porcentaje
  
  scale_y_continuous(labels = function(x) paste0(x, "%"),
                     limits = c(0, max(TDF_final_zoom$hi_porc) * 1.1),
                     expand = c(0, 0)) +
  
  labs(
    title = "Gráfica No. 1: Histograma Distribución Porcentual de Costos Totales",
    x = "Costos Totales (USD)",
    y = "Porcentaje"
  ) +
  

  theme_classic() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
    plot.subtitle = element_text(hjust = 0.5, size = 11),
    axis.text.x = element_text(angle = 45, hjust = 1)
  )

SEGMENTACIÓN

Con el fin de optimizar el ajuste estadístico, la visualización se fragmenta en dos estratos: el primero analizado bajo una distribución exponencial para representar costos menores, y el segundo mediante una distribución log-normal diseñada para caracterizar el segmento final de la distribución, donde residen los costos con de mayor impacto financiero.”

K_suave <- 12 
A_suave <- (xmax_z - xmin_z) / K_suave
cortes_suave <- seq(xmin_z, xmin_z + (K_suave * A_suave), length.out = K_suave + 1)

#  (Límite superior de la barra 7)

punto_corte <- cortes_suave[8] 

#  Separar el vector de datos 

datos_exponencial <- datos_zoom[datos_zoom <= punto_corte]
datos_lognormal   <- datos_zoom[datos_zoom > punto_corte]

# Verificación de resultados 
cat("Punto de corte definido en:", round(punto_corte, 2), "USD\n")

## Punto de corte definido en: 306658.8 USD

K_total <- 12 
A_hibrido <- (xmax_z - xmin_z) / K_total
cortes_h <- seq(xmin_z, xmin_z + (K_total * A_hibrido), length.out = K_total + 1)

ni_h <- as.vector(table(cut(datos_zoom, breaks = cortes_h, include.lowest = TRUE)))
hi_h <- (ni_h / length(datos_zoom)) * 100
MC_h <- (cortes_h[1:K_total] + cortes_h[2:(K_total + 1)]) / 2

df_primeras_7 <- data.frame(MC = MC_h, hi = hi_h)[1:7, ]

# Generación de la grafica 

ggplot(df_primeras_7, aes(x = MC, y = hi)) +
  geom_bar(stat = "identity", fill = "#4682B4", color = "black", alpha = 0.8, width = A_hibrido) + 
  scale_x_continuous(breaks = round(cortes_h[1:8], 0), labels = scales::dollar_format()) +
  scale_y_continuous(labels = function(x) paste0(x, "%"), expand = expansion(mult = c(0, 0.1))) +
  labs(
    title = "Grafica 2 : Histograma porcentual del Segmento Inicial de Costos Totales",
    subtitle = "Visualización de las primeras 7 clases de frecuencia",
    x = "Costos Totales (USD)", y = "Porcentaje"
  ) +
  theme_classic() +
  theme(plot.title = element_text(face = "bold", size = 12), axis.text.x = element_text(angle = 45, hjust = 1))

# --- DEFINICIÓN DEL RANGO INTERMEDIO ---
inicio <- 8
fin <- K_total - 1 

df_intermedio <- data.frame(MC = MC_h, hi = hi_h)[inicio:fin, ]

# Generación de la gafica 
ggplot(df_intermedio, aes(x = MC, y = hi)) +
  geom_bar(stat = "identity", fill = "#4682B4", color = "black", alpha = 0.8, width = A_hibrido) + 
  scale_x_continuous(breaks = round(cortes_h[inicio:(fin + 1)], 0), labels = scales::dollar_format()) +
  scale_y_continuous(labels = function(x) paste0(x, "%"), expand = expansion(mult = c(0, 0.1))) +
  labs(
    title = "Gráfica N 3: Histograma porcentual del Segmento Final de Costos Totales",
    x = "Costos Totales (USD)", y = "Porcentaje"
  ) +
  theme_classic() +
  theme(plot.title = element_text(face = "bold", size = 12), axis.text.x = element_text(angle = 45, hjust = 1))

CONJETURA DE MODELO (PRIMER SEGMENTO)

MODELO EXPONCIAL

Se selecciono el modelo exponencial para este segmento porque visualmente las barras muestran un decaimiento constante este comportamiento “en escalera descendente” es la firma visual característica de una función exponencial .

# 1. Filtrado de datos para el primer segmento 
punto_corte_7 <- cortes_h[8]
datos_segmento_exp <- datos_zoom[datos_zoom <= punto_corte_7]

# 2. Estimación de parámetros del modelo

media_exp <- mean(datos_segmento_exp)
lambda_exp <- 1 / media_exp

cat("Análisis de tendencia para el segmento inicial:\n")

## Análisis de tendencia para el segmento inicial:

cat("Media de costos del estrato:", round(media_exp, 2), "USD\n")

## Media de costos del estrato: 44363.21 USD

cat("Parámetro Lambda (tasa):", lambda_exp, "\n")

## Parámetro Lambda (tasa): 2.25412e-05

#  Generación de la curva 
x_vals <- seq(min(df_primeras_7$MC), max(df_primeras_7$MC), length.out = 100)

# Ajuste de escala
y_vals <- dexp(x_vals, rate = lambda_exp) * A_hibrido * 100
df_curva_exp <- data.frame(x = x_vals, y = y_vals)

# 2. Construcción de la gráfica de conjetura
ggplot(df_primeras_7, aes(x = MC, y = hi)) +
  geom_bar(stat = "identity", fill = "#4682B4", color = "black", alpha = 0.7, width = A_hibrido) +
  
  # Superposición de la curva de conjetura (Modelo Rojo)
  geom_line(data = df_curva_exp, aes(x = x, y = y), color = "red", size = 1.2) +
  
  # Formatos de ejes y etiquetas profesionales
  scale_x_continuous(breaks = round(cortes_h[1:8], 0), labels = scales::dollar_format()) +
  scale_y_continuous(labels = function(x) paste0(x, "%"), expand = expansion(mult = c(0, 0.1))) +
  
  labs(
    title = "Grafica N 4:  Modelo de probabilidad exponencial para costos totales ",

    x = "Costos Totales (USD)",
    y = "Porcentaje"
  ) +
  theme_classic() +
  theme(
    plot.title = element_text(face = "bold", size = 13),
    axis.text.x = element_text(angle = 45, hjust = 1)
  )

TEST DE PERSON

# 1. Definir Frecuencia Observada 
Fo <- ni_h[1:7] 

# 2. Calcular Probabilidades Teóricas 
h_segmento <- 7
P <- numeric(h_segmento)

for (i in 1:h_segmento) {

    P[i] <- pexp(cortes_h[i+1], rate = lambda_exp) - 
          pexp(cortes_h[i], rate = lambda_exp)
}

# 3. Calcular Frecuencia Esperada (Fe)
n_segmento <- length(datos_segmento_exp)
Fe <- P * n_segmento

# 4. Cálculo de Correlación de Pearson

Correlacion_Exp <- cor(Fo, Fe) * 100

cat("--- CONCLUSIÓN DE LA CONJETURA EXPONENCIAL ---\n")

## --- CONCLUSIÓN DE LA CONJETURA EXPONENCIAL ---

cat("Tamaño de la muestra segmentada:", n_segmento, "registros\n")

## Tamaño de la muestra segmentada: 2366 registros

cat("Correlación del modelo:", round(Correlacion_Exp, 2), "%\n")

## Correlación del modelo: 97.32 %

TEST CHI-CUADRADO

# 1. Grados de libertad (k - 1 - parámetros estimados)
grados_libertad <- (h_segmento - 2) 

# 2. Nivel de significancia
nivel_significancia <- 0.000001

# 3. Preparación de Frecuencias Porcentuales
Fo_porc <- (ni_h[1:7] / n_segmento) * 100
Fe_porc <- P * 100

# 4. Cálculo del estadístico Chi-Cuadrado 
x2 <- sum((Fe_porc - Fo_porc)^2 / Fe_porc)

# 5. Determinación (Umbral)
umbral_aceptacion <- qchisq(1 - nivel_significancia, grados_libertad)

# 6. Resultado de
modelo_aceptado <- x2 < umbral_aceptacion

cat("Estadístico Chi-Cuadrado calculado:", round(x2, 4), "\n")

## Estadístico Chi-Cuadrado calculado: 34.1259

cat("Umbral de aceptación (Valor Crítico):", round(umbral_aceptacion, 4), "\n")

## Umbral de aceptación (Valor Crítico): 35.8882

cat("¿El modelo es aceptado estadísticamente?:", ifelse(modelo_aceptado, "SÍ", "NO"), "\n")

## ¿El modelo es aceptado estadísticamente?: SÍ

CONJETURA DE MODELO(SEGMENTO FINAL)

MODELO LOG-NORMAL

“Visualmente, a partir de la barra 8, el decaimiento ya no es tan rápido como al inicio. Las barras se mantienen más estables y se extienden hacia costos mayores. El modelo Log-Normal es el que mejor representa esta ‘cola’ de la distribución, permitiéndonos modelar el riesgo de derrames más costosos con mayor precisión”.

# 1. Filtrado de datos 
datos_intermedios <- datos_zoom[datos_zoom >= cortes_h[inicio] & datos_zoom <= cortes_h[fin + 1]]

# 2. Estimar parámetros de los logaritmos
ulog_int <- mean(log(datos_intermedios))
sigmalog_int <- sd(log(datos_intermedios))


# 1. Mostrar los parámetros calculados en el informe
cat("PARÁMETROS DEL MODELO LOG-NORMAL \n")

## PARÁMETROS DEL MODELO LOG-NORMAL

cat("Media Logarítmica (ulog):     ", round(ulog_int, 4), "\n")

## Media Logarítmica (ulog):      12.8591

cat("Desviación Estándar (sigma): ", round(sigmalog_int, 4), "\n")

## Desviación Estándar (sigma):  0.1181

# 3. Cálculo de Frecuencias Esperadas (Fe)
h_int <- nrow(df_intermedio) 
P_ln <- numeric(h_int)

for (i in 1:h_int) {
  P_ln[i] <- plnorm(cortes_h[inicio + i], ulog_int, sigmalog_int) - 
             plnorm(cortes_h[inicio + i - 1], ulog_int, sigmalog_int)
}

Fe_int_porc <- (P_ln / sum(P_ln)) * sum(df_intermedio$hi)


# 1. Preparación de la curva 
x_curva_ln <- seq(min(cortes_h[inicio]), max(cortes_h[fin + 1]), length.out = 100)
y_curva_ln <- dlnorm(x_curva_ln, ulog_int, sigmalog_int) * A_hibrido * 100 

df_curva_ln <- data.frame(x = x_curva_ln, y = y_curva_ln)



ggplot(df_intermedio, aes(x = MC, y = hi)) +
  geom_bar(stat = "identity", fill = "#4682B4", color = "black", alpha = 0.7, width = A_hibrido) +
  
  # Curva de conjetura Log-Normal
  geom_line(data = df_curva_ln, aes(x = x, y = y), color = "red", size = 1.2) +
  
  scale_x_continuous(breaks = round(cortes_h[inicio:(fin + 1)], 0), labels = scales::dollar_format()) +
  scale_y_continuous(labels = function(x) paste0(x, "%"), expand = expansion(mult = c(0, 0.1))) +
  
  labs(
    title = "Gráfica N 4 : Modelo DE PROBBILIDAD Log-Normal para costos totales ",
    x = "Costos Totales (USD)",
    y = "Porcentaje"
  ) +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        plot.title = element_text(face = "bold"))

TEST DE PEARSON

# 1. Definición de Frecuencia Observada 

Fo_int <- ni_h[inicio:fin] 

# 2. Cálculo de Frecuencia Esperada (Fe)

n_int <- length(datos_intermedios)
Fe_int <- P_ln * n_int

# 3. Cálculo de Correlación de Pearson

Correlacion_LN <- cor(Fo_int, Fe_int) * 100

cat("--- VALIDACIÓN DEL MODELO LOG-NORMAL ---\n")

## --- VALIDACIÓN DEL MODELO LOG-NORMAL ---

cat("Tamaño del segmento analizado:", n_int, "registros\n")

## Tamaño del segmento analizado: 93 registros

cat("Correlación de Pearson:", round(Correlacion_LN, 2), "%\n")

## Correlación de Pearson: 96.25 %

TEST CHI-CUADRADO

# 1. Determinación de Grados de Libertad (k - 1 - m)
grados_libertad_ln <- (length(Fo_int) - 1 - 2)
grados_libertad_ln <- max(1, grados_libertad_ln)

# 2. Definición del Nivel de Significancia
nivel_significancia_ln <- 0.0001

# 3. Preparación de Frecuencias Porcentuales 
Fo_ln_porc <- (Fo_int / sum(Fo_int)) * 100
Fe_ln_porc <- (P_ln / sum(P_ln)) * 100

# 4. Cálculo del estadístico Chi-Cuadrado
x2_ln <- sum((Fe_ln_porc - Fo_ln_porc)^2 / Fe_ln_porc)

# 5. Determinación del Valor Crítico (Umbral)
umbral_aceptacion_ln <- qchisq(1 - nivel_significancia_ln, grados_libertad_ln)

# 6. Evaluación de la Hipótesis
aceptacion_final <- x2_ln < umbral_aceptacion_ln

cat("Estadístico Chi-Cuadrado (Calculado):", round(x2_ln, 4), "\n")

## Estadístico Chi-Cuadrado (Calculado): 4.5637

cat("Valor Crítico (Tabla):", round(umbral_aceptacion_ln, 4), "\n")

## Valor Crítico (Tabla): 15.1367

cat("¿Se acepta la conjetura Log-Normal?:", ifelse(aceptacion_final, "SÍ (Aceptado)", "NO (Rechazado)"), "\n")

## ¿Se acepta la conjetura Log-Normal?: SÍ (Aceptado)

Integración del Modelo Híbrido

# 1. Extraemos los datos del segmento exponencial 
df_exp_final <- data.frame(MC = MC_h[1:7], hi = hi_h[1:7])
df_exp_final$Modelo <- "Zona Exponencial"

# 2. Extraemos los datos del segmento log-normal 
df_ln_final <- data.frame(MC = MC_h[inicio:fin], hi = hi_h[inicio:fin])
df_ln_final$Modelo <- "Zona Log-Normal"

# 3. Unimos ambos segmentos en un solo objeto llamado 'df_grafica'
df_grafica <- rbind(df_exp_final, df_ln_final)




df_exp_final <- data.frame(MC = MC_h[1:7], hi = hi_h[1:7], Modelo = "Zona Exponencial")
df_ln_final  <- data.frame(MC = MC_h[inicio:fin], hi = hi_h[inicio:fin], Modelo = "Zona Log-Normal")
df_grafica   <- rbind(df_exp_final, df_ln_final)

# 2. Preparación de las curvas teóricas 
df_curva_exp <- data.frame(x = x_vals, y = y_vals)
df_curva_ln  <- data.frame(x = x_curva_ln, y = y_curva_ln)

# 3. Generación de la Gráfica 
ggplot() +
  # Capa de Barras
  geom_bar(data = df_grafica, aes(x = MC, y = hi, fill = Modelo), 
           stat = "identity", color = "black", alpha = 0.5, width = A_hibrido) +
  
  # Capa Línea Exponencial (Roja)
  geom_line(data = df_curva_exp, aes(x = x, y = y), 
            color = "red", size = 1.2) +
  
  # Capa Línea Log-Normal (Verde)
  geom_line(data = df_curva_ln, aes(x = x, y = y), 
            color = "darkgreen", size = 1.2) +
  
  # Estética y Formatos
  scale_fill_manual(values = c("Zona Exponencial" = "steelblue", 
                               "Zona Log-Normal" = "orange")) +
  scale_x_continuous(labels = scales::dollar_format()) +
  scale_y_continuous(labels = function(x) paste0(x, "%"), 
                     expand = expansion(mult = c(0, 0.1))) +
  
  labs(title = "Gráfica N 5: Modelado hibrído de probabilidad para costos totales",
       subtitle = "Exponencial (0-150k)  Log-Normal (150k-300k)",
       x = "Costos Totales (USD)",
       y = "Densidad de probabilidad ",
       fill = "Segmento de Análisis") +
  
  theme_minimal() +
  theme(legend.position = "bottom",
        plot.title = element_text(face = "bold", size = 14),
        axis.text.x = element_text(angle = 45, hjust = 1))

TABLA DE RESUMEN

Segmentos <- c("Modelo (Exponencial)", "Modelo (Log-Normal)")

# 2. Creación del Dataframe
tabla_resumen <- data.frame(
  Variable = Segmentos,
  Pearson  = c(round(Correlacion_Exp, 2), round(Correlacion_LN, 2)),
  Chi_Sq   = c(round(x2, 2), round(x2_ln, 2)),
  Umbral   = c(round(umbral_aceptacion, 2), round(umbral_aceptacion_ln, 2))
)

colnames(tabla_resumen) <- c("Segmento de Costos", "Test Pearson (%)", "Chi Cuadrado", "Umbral de Aceptación")

# 4. Generación de la tabla 
kable(tabla_resumen, 
      format = "markdown", 
      align = "lccc",
      caption = "Tabla Nro. 3: Resumen de test de bondad al modelo de probabilidad exponencial  log- normal")

Tabla Nro. 3: Resumen de test de bondad al modelo de probabilidad exponencial log- normal
Segmento de Costos	Test Pearson (%)	Chi Cuadrado	Umbral de Aceptación
Modelo (Exponencial)	97.32	34.13	35.89
Modelo (Log-Normal)	96.25	4.56	15.14

CÁLCULO DE PROBABILIDADES

¿Cuál es la probabilidad de que un derrame de petróleo futuro en Estados Unidos genere costos totales menores a $100.000?

# 1. Definición del umbral de interés
costo_limite <- 100000

# 2. Cálculo de la probabilidad acumulada P(X <= x)
probabilidad_menor_100k <- pexp(costo_limite, rate = lambda_exp)

# 3. Visualización de resultados en el informe
cat("PROBABILIDAD DE COSTOS MENORES A $100000 EN EL SIGUIENTE DERRAME \n")

## PROBABILIDAD DE COSTOS MENORES A $100000 EN EL SIGUIENTE DERRAME

cat("La probabilidad de que un derrame futuro en EE.UU. genere costos totales \n")

## La probabilidad de que un derrame futuro en EE.UU. genere costos totales

cat("menores a $100,000 es del:", round(probabilidad_menor_100k * 100, 2), "%\n")

## menores a $100,000 es del: 89.5 %

De los proximos 100 derrames ¿cuantos derramese espera que supere los $300000 en costos totales?

# 1. Determinación del peso del segmento Log-Normal 
peso_segmento_log <- sum(hi_h[8:12]) / 100 

# 2. Cálculo de la Probabilidad Condicional (P(X > 300k | Segmento Log-Normal))
prob_condicional <- plnorm(300000, meanlog = ulog_int, sdlog = sigmalog_int, lower.tail = FALSE)

# 3. Probabilidad Real Combinada 
prob_real_exceder <- prob_condicional * peso_segmento_log

# 4. Proyección de Frecuencia Esperada
cantidad_logica <- 100 * prob_real_exceder

cat("ANÁLISIS DE RIESGO: COSTOS MAYORES A $300,000\n")

## ANÁLISIS DE RIESGO: COSTOS MAYORES A $300,000

cat("Probabilidad real de excedencia:", round(prob_real_exceder * 100, 2), "%\n")

## Probabilidad real de excedencia: 4.7 %

cat("Expectativa estadística en 100 incidentes:", round(cantidad_logica, 0), "casos.\n")

## Expectativa estadística en 100 incidentes: 5 casos.

CÁLCULO GRÁFICO DE PROBABILIDADES

# 1. Preparar datos para las áreas sombreadas
df_sombra_exp <- data.frame(x = seq(xmin_z, 100000, length.out = 100))
df_sombra_exp$y <- dexp(df_sombra_exp$x, rate = lambda_exp) * A_hibrido * 100

# Área Log-Normal (Probabilidad de costos mayores a 300k)
# Se define el límite superior basado en los cortes del modelo
df_sombra_ln <- data.frame(x = seq(300000, max(cortes_h), length.out = 100))
df_sombra_ln$y <- dlnorm(df_sombra_ln$x, meanlog = ulog_int, sdlog = sigmalog_int) * A_hibrido * 100

# 2. Generación de la Gráfica Maestra
ggplot() +
  # Histograma base suavizado
  geom_bar(data = df_grafica, aes(x = MC, y = hi, fill = Modelo), 
           stat = "identity", color = "black", alpha = 0.2, width = A_hibrido) +
  
  # Sombreado de Probabilidad < $100k (Zona de Alta Frecuencia)
  geom_ribbon(data = df_sombra_exp, aes(x = x, ymin = 0, ymax = y), 
              fill = "red", alpha = 0.4) +
  
  # Sombreado de Probabilidad > $300k (Zona de Riesgo Crítico)
  geom_ribbon(data = df_sombra_ln, aes(x = x, ymin = 0, ymax = y), 
              fill = "darkgreen", alpha = 0.4) +
  
  # Líneas de tendencia de los modelos validados
  geom_line(data = df_curva_exp, aes(x = x, y = y), color = "red", size = 1) +
  geom_line(data = df_curva_ln, aes(x = x, y = y), color = "darkgreen", size = 1) +
  
  # Estética profesional
  scale_fill_manual(values = c("Zona Exponencial" = "steelblue", "Zona Log-Normal" = "orange")) +
  scale_x_continuous(labels = scales::dollar_format(), limits = c(0, 550000)) +
  scale_y_continuous(labels = function(x) paste0(x, "%")) +
  
  labs(title = "Cálculo de Probabilidades sobre el Modelo Híbrido",
       subtitle = "Sombreado Rojo: P(<100k) | Sombreado Verde: P(>300k)",
       x = "Costos Totales (USD)", y = "Densidad de probabilidad",
       fill = "Segmento") +
  
  theme_minimal() +
  theme(legend.position = "bottom", plot.title = element_text(face = "bold"))

# 3. Impresión de Resultados Finales para el Reporte
cat("RESUMEN DE INFERENCIA PROBABILÍSTICA\n")

## RESUMEN DE INFERENCIA PROBABILÍSTICA

cat("1. Probabilidad de costos menores a $100k (Área Roja):", round(probabilidad_menor_100k * 100, 2), "%\n")

## 1. Probabilidad de costos menores a $100k (Área Roja): 89.5 %

cat("2. Probabilidad de costos mayores a $300k (Área Verde):", round(prob_real_exceder * 100, 2), "%\n")

## 2. Probabilidad de costos mayores a $300k (Área Verde): 4.7 %

TEOREMA DE LÍMITE CENTRAL

Tras validar los modelos híbridos, aplicamos el Teorema del Límite Central para obtener una estimación global del costo poblacional. Esta tabla consolida el valor esperado de un derrame y su margen de error estadístico. A diferencia del análisis segmentado (Híbrido), esta estimación proporciona un marco de referencia global. Al afirmar que el costo promedio se encuentra entre el Límite Inferior y el Límite Superior con un 95% de confianza, estamos cuantificando la incertidumbre total del proyecto”

# 1. Cálculo de estadísticos descriptivos básicos
n_total <- length(All.Costs)         
x_bar_c <- mean(All.Costs)           
sd_c <- sd(All.Costs)                

# 2. Parámetros para el Teorema del Límite Centra
z_95 <- 1.96                         
error_estandar <- sd_c / sqrt(n_total) 
margen_error_95_c <- z_95 * error_estandar

# 3. Estimación de la Media Poblacional 
lim_inf_c <- x_bar_c - margen_error_95_c
lim_sup_c <- x_bar_c + margen_error_95_c


# 1. Crear el dataframe para la tabla (Ahora con todos los datos calculados arriba)
tabla_costos_tlc <- data.frame(
  Parametro = "Costo Total Promedio por Derrame",
  Lim_Inferior = lim_inf_c,
  Media_Muestral = x_bar_c,
  Lim_Superior = lim_sup_c,
  Error_Estandar = paste0("+/- ", sprintf("%.2f", margen_error_95_c)),
  Confianza = "95% (Z=1.96)"
)

# 2. Generar la tabla con formato profesional
tabla_final <- tabla_costos_tlc %>%
  gt() %>%
  tab_header(
    title = md("**ESTIMACIÓN DE LA MEDIA POBLACIONAL DE COSTOS TOTALES**"),
    subtitle = "Inferencia Global basada en el Teorema del Límite Central"
  ) %>%
  cols_label(
    Parametro = "Parámetro",
    Lim_Inferior = "Límite Inferior (USD)",
    Media_Muestral = "Costo Promedio (USD)",
    Lim_Superior = "Límite Superior (USD)",
    Error_Estandar = "Margen de Error"
  ) %>%
  fmt_currency(
    columns = c(Lim_Inferior, Media_Muestral, Lim_Superior),
    currency = "USD",
    decimals = 2
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#FBEEE6"), cell_text(color = "#A04000", weight = "bold")),
    locations = cells_body(columns = Media_Muestral)
  )

# Mostrar la tabla en el R Markdown
tabla_final

Parámetro	Límite Inferior (USD)	Costo Promedio (USD)	Límite Superior (USD)	Margen de Error	Confianza
ESTIMACIÓN DE LA MEDIA POBLACIONAL DE COSTOS TOTALES
Inferencia Global basada en el Teorema del Límite Central
Costo Total Promedio por Derrame	$222,125.76	$844,303.85	$1,466,481.94	+/- 622178.09	95% (Z=1.96)

CONCLUSIONES

La variable Costos Totales, presenta un comportamiento híbrido que ha sido modelado con éxito mediante una Distribución Exponencial para incidentes de alta frecuencia, y una Distribución Log-Normal para costos totales muy altos.Con una media aritmética poblacional de $844,303.85, definido por una desviación estándar de 102072.4

Mediante el Teorema del Límite Central, sabemos que la media aritmética poblacional del costo total se encuentra entre$[222,125.76 ; 1,466,481.94]$ USD con un 95% de confianza, lo que permite establecer previsiones financieras sólidas$\mu = 844,303.85 \pm 622,178.09$).

Variable cuantitativa continua: Costos Totales.

Ronal Calderon

2026-02-05

IDENTIFICACION Y JUSTIFICACIÓN DE LA VARIABLE

CARGAR DATOS

EXTRAER LA VARIABLE

TABLA DE FRECUENCIA

NUEVA TABLA DE DISTRIBUCIÓN DE FRECUENCIA

GRÁFICAS

SEGMENTACIÓN

CONJETURA DE MODELO (PRIMER SEGMENTO)

MODELO EXPONCIAL

TEST DE PERSON

TEST CHI-CUADRADO

CONJETURA DE MODELO(SEGMENTO FINAL)

MODELO LOG-NORMAL

TEST DE PEARSON

TEST CHI-CUADRADO

Integración del Modelo Híbrido

TABLA DE RESUMEN

CÁLCULO DE PROBABILIDADES

CÁLCULO GRÁFICO DE PROBABILIDADES

TEOREMA DE LÍMITE CENTRAL

CONCLUSIONES