library(plotly)
library(DT)
library(kableExtra)
library(knitr)       
library(scales)      
library(dplyr)

📊 Teoría de Decisiones

Desde los fundamentos hasta los modelos más avanzados: criterios, valor esperado, VEIP, Bayes y árboles de decisión.

1. Fundamentos

¿Qué es la Teoría de Decisiones?

La Teoría de Decisiones es un marco matemático para tomar decisiones racionales bajo incertidumbre.

Definición formal:
Es una rama de la matemática aplicada y la economía que estudia cómo un agente racional debe elegir entre alternativas cuando los resultados dependen de factores inciertos (estados de la naturaleza).

Tipos de decisiones

  • Decisión bajo incertidumbre 🎲
    • No conocemos probabilidades.
    • Ejemplo: criterios Maximax, Maximin, Hurwicz.
  • Decisión bajo riesgo 📊
    • Se conocen probabilidades.
    • Se usa valor esperado, VEIP, árboles de decisión.
  • Decisión bajo certeza ✅
    • Se conoce el estado que ocurrirá.
    • Es un problema de optimización.
  • Decisión multicriterio🧠
    • Múltiples objetivos.
    • Métodos: AHP, TOPSIS.

Componentes de un problema de decisión

  • Alternativas (Ai):
    Las posibles acciones que puede tomar el decisor. Ejemplo: construir planta grande, pequeña o no construir.

  • Estados de la naturaleza (Sj):
    Eventos fuera del control del decisor que afectan el resultado. Ejemplo: demanda alta, media o baja.

  • Resultados o pagos (Vij):
    La consecuencia de elegir alternativa i cuando ocurre el estado j. Organizados en la Tabla de Pagos.

  • Probabilidades (pj):
    Cuando son conocidas, permiten calcular el valor esperado. Pueden ser objetivas o subjetivas (Bayesianas).

Caso de estudio: TechParts S.A.

Una empresa debe decidir cuánta capacidad de producción instalar ante una demanda de mercado incierta. Usaremos este ejemplo a lo largo de toda la guía.

# Tu matriz original
pagos <- matrix(c(
  -200000, 100000, 500000,
  -50000, 200000, 300000,
  100000, 150000, 180000,
  50000, 50000, 50000
), nrow = 4, byrow = TRUE)

colnames(pagos) <- c("Demanda Baja", "Demanda Media", "Demanda Alta")
rownames(pagos) <- c("A1:Planta Grande", "A2:Planta Mediana", "A3:Planta Pequena", "A4:No construir")

# ✅ SOLUCIÓN: Convierte a data.frame
pagos_df <- as.data.frame(pagos)
rownames(pagos_df) <- rownames(pagos)
kable(pagos_df, digits = 0) %>%
  kable_styling("striped", full_width = FALSE) %>%
  row_spec(0, bold = TRUE, background = "steelblue", color = "white")
Demanda Baja Demanda Media Demanda Alta
A1:Planta Grande -2e+05 100000 500000
A2:Planta Mediana -5e+04 200000 300000
A3:Planta Pequena 1e+05 150000 180000
A4:No construir 5e+04 50000 50000

💡 Los valores representan ganancias/pérdidas netas anuales en dólares.

2 Criterios

Criterios de Decisión bajo

Incertidumbre

Cuando no conocemos las probabilidades de los estados de naturaleza.

2.1 Criterio MAXIMAX (Optimista)

Filosofía: “El optimista puro.” Para cada alternativa toma el mejor resultado posible, luego elige la alternativa con el máximo de esos máximos.

Maximax = max_i { max_j (Vᵢⱼ) }

       # Para mutate(), across()

# Cálculo del criterio Maximax
max_fila <- apply(pagos, 1, max)
idx_maximax <- which.max(max_fila)
decision_maximax <- rownames(pagos)[idx_maximax]

# Tabla de resultados
resultado_df <- as.data.frame(pagos)
resultado_df$`MAX FILA` <- max_fila
resultado_df$`MAX FILA` <- ifelse(
  seq_len(nrow(resultado_df)) == idx_maximax,
  paste0(dollar(max_fila, prefix="$", big.mark=","), " ★"),
  dollar(max_fila, prefix="$", big.mark=",")
)

resultado_df %>%
  mutate(across(1:3, ~ dollar(.x, prefix="$", big.mark=","))) %>%
  kbl(caption = "Criterio MAXIMAX — Máximo de los máximos") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","bordered"),
                full_width = FALSE) %>%
  column_spec(5, bold = TRUE, color = "#27ae60") %>%
  row_spec(idx_maximax, background = "#eafaf1")
Criterio MAXIMAX — Máximo de los máximos
Demanda Baja Demanda Media Demanda Alta MAX FILA
A1:Planta Grande -$200,000 $100,000 $500,000 $500,000 ★
A2:Planta Mediana -$50,000 $200,000 $300,000 $300,000
A3:Planta Pequena $100,000 $150,000 $180,000 $180,000
A4:No construir $50,000 $50,000 $50,000 $50,000 
cat("✅ Decisión MAXIMAX:", decision_maximax, "→ $", dollar(max(max_fila)))
## ✅ Decisión MAXIMAX: A1:Planta Grande → $ $500,000

Decisión Maximax: A1 (Planta Grande) con $500,000. El optimista apuesta por el mejor escenario posible. ⚠️ Ignora completamente los resultados negativos: ¡podría perder $200,000!

2.2 Criterio MAXIMIN — Wald (Pesimista)

Filosofía: “El pesimista conservador.” Para cada alternativa toma el peor resultado, luego elige la alternativa con el mejor de esos peores resultados.

Maximin = max_i { min_j (Vᵢⱼ) }

min_fila <- apply(pagos, 1, min)
idx_maximin <- which.max(min_fila)
decision_maximin <- rownames(pagos)[idx_maximin]

resultado_df2 <- as.data.frame(pagos)
resultado_df2$`MIN FILA` <- ifelse(
  seq_len(nrow(resultado_df2)) == idx_maximin,
  paste0(dollar(min_fila, prefix="$", big.mark=","), " ★"),
  dollar(min_fila, prefix="$", big.mark=",")
)

resultado_df2 %>%
  mutate(across(1:3, ~ dollar(.x, prefix="$", big.mark=","))) %>%
  kbl(caption = "Criterio MAXIMIN — Máximo de los mínimos (Wald)") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","bordered"),
                full_width = FALSE) %>%
  column_spec(5, bold = TRUE, color = "#e74c3c") %>%
  row_spec(idx_maximin, background = "#fdf2f2")
Criterio MAXIMIN — Máximo de los mínimos (Wald)
Demanda Baja Demanda Media Demanda Alta MIN FILA
A1:Planta Grande -$200,000 $100,000 $500,000 -$200,000
A2:Planta Mediana -$50,000 $200,000 $300,000 -$50,000
A3:Planta Pequena $100,000 $150,000 $180,000 $100,000 ★
A4:No construir $50,000 $50,000 $50,000 $50,000

✅ Decisión Maximin: A3 (Planta Pequeña) con $100,000 mínimo garantizado. El conservador protege lo que tiene.

2.3 Criterio de HURWICZ (Coeficiente de Optimismo)

Filosofía: “El término medio.” Combina el optimismo (α) y el pesimismo (1−α) con un coeficiente de optimismo α ∈ [0,1].

H(Aᵢ) = α · max_j(Vᵢⱼ) + (1−α) · min_j(Vᵢⱼ)

Hurwicz = max_i { H(Aᵢ) }

# Cálculo de Hurwicz para α = 0.6
alpha <- 0.6

H <- alpha * max_fila + (1 - alpha) * min_fila
idx_hurwicz <- which.max(H)
decision_hurwicz <- rownames(pagos)[idx_hurwicz]

resultado_H <- data.frame(
  Alternativa  = rownames(pagos),
  `Max Fila`   = dollar(max_fila, prefix="$", big.mark=","),
  `Min Fila`   = dollar(min_fila, prefix="$", big.mark=","),
  `H(α=0.6)`   = dollar(round(H), prefix="$", big.mark=","),
  check.names  = FALSE
)
resultado_H$`H(α=0.6)` <- ifelse(
  seq_len(nrow(resultado_H)) == idx_hurwicz,
  paste0(resultado_H$`H(α=0.6)`, " ★"),
  resultado_H$`H(α=0.6)`
)

resultado_H %>%
  kbl(caption = paste0("Criterio HURWICZ — α = ", alpha)) %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","bordered"),
                full_width = FALSE) %>%
  column_spec(4, bold = TRUE, color = "#0e48ad") %>%
  row_spec(idx_hurwicz, background = "#f5eef8")
Criterio HURWICZ — α = 0.6
Alternativa Max Fila Min Fila H(α=0.6)
A1:Planta Grande A1:Planta Grande $500,000 -$200,000 $220,000 ★
A2:Planta Mediana A2:Planta Mediana $300,000 -$50,000 $160,000
A3:Planta Pequena A3:Planta Pequena $180,000 $100,000 $148,000
A4:No construir A4:No construir $50,000 $50,000 $50,000 
cat("✅ Decisión HURWICZ (α=0.6):", decision_hurwicz, "→ H =", dollar(max(H)))
## ✅ Decisión HURWICZ (α=0.6): A1:Planta Grande → H = $220,000
# Análisis de sensibilidad de Hurwicz
alphas <- seq(0, 1, by = 0.01)

hurwicz_df <- lapply(alphas, function(a) {
  H_vals <- a * max_fila + (1 - a) * min_fila
  data.frame(
    alpha        = a,
    H            = H_vals,
    Alternativa  = rownames(pagos)
  )
}) %>% bind_rows()

ggplot(hurwicz_df, aes(x = alpha, y = H, color = Alternativa)) +
  geom_line(linewidth = 1.1) +
  geom_vline(xintercept = 0.6, linetype = "dashed", color = "gray40", linewidth = 0.8) +
  annotate("text", x = 0.62, y = min(hurwicz_df$H) + 30000,
           label = "α = 0.6", color = "gray40", size = 3.5) +
  scale_y_continuous(labels = dollar_format(prefix = "$")) +
  scale_color_brewer(palette = "Set2") +
  labs(
    title    = "Análisis de Sensibilidad — Criterio de Hurwicz",
    subtitle = "Variación de H(Aᵢ) según el coeficiente de optimismo α",
    x        = "Coeficiente de Optimismo (α)",
    y        = "Valor Hurwicz H(Aᵢ)",
    color    = "Alternativa"
  ) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom")

2.4 Criterio de LAPLACE (Razón Insuficiente)

Filosofía: “Si no sé las probabilidades, las supongo iguales.” Asigna probabilidad 1/n a cada estado y calcula el promedio de pagos.

L(Aᵢ) = (1/n) · Σⱼ Vᵢⱼ donde n = número de estados

# Cálculo de Laplace
n_estados <- ncol(pagos)
laplace_vals <- rowMeans(pagos)
idx_laplace <- which.max(laplace_vals)
decision_laplace <- rownames(pagos)[idx_laplace]

resultado_L <- as.data.frame(pagos)
resultado_L$`PROMEDIO (÷3)` <- ifelse(
  seq_len(nrow(resultado_L)) == idx_laplace,
  paste0(dollar(round(laplace_vals), prefix="$", big.mark=","), " ★"),
  dollar(round(laplace_vals), prefix="$", big.mark=",")
)

resultado_L %>%
  mutate(across(1:3, ~ dollar(.x, prefix="$", big.mark=","))) %>%
  kbl(caption = "Criterio LAPLACE — Promedio equiprobable") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","bordered"),
                full_width = FALSE) %>%
  column_spec(5, bold = TRUE, color = "#7380b8") %>%
  row_spec(idx_laplace, background = "#eaf4fb")
Criterio LAPLACE — Promedio equiprobable
Demanda Baja Demanda Media Demanda Alta PROMEDIO (÷3)
A1:Planta Grande -$200,000 $100,000 $500,000 $133,333
A2:Planta Mediana -$50,000 $200,000 $300,000 $150,000 ★
A3:Planta Pequena $100,000 $150,000 $180,000 $143,333
A4:No construir $50,000 $50,000 $50,000 $50,000

✅ Decisión Laplace: A2 (Planta Mediana) con promedio $150,000. Equilibra riesgo y recompensa.

2.5 Criterio MINIMAX REGRET — Savage

Filosofía: Minimizar el “arrepentimiento” máximo. El arrepentimiento (regret) es cuánto dejaste de ganar por no haber elegido la mejor alternativa dado el estado que ocurrió.

Regret(i,j) = max_i(Vᵢⱼ) − Vᵢⱼ (lo que perdiste por no elegir lo mejor)

Minimax Regret = min_i { max_j Regret(i,j) }

# Paso 1: Tabla de arrepentimientos
max_col <- apply(pagos, 2, max)
regret  <- sweep(-pagos, 2, -max_col, "+")   # regret[i,j] = max_col[j] - pagos[i,j]

# Paso 2: Máximo regret por fila → elegir el mínimo
max_regret  <- apply(regret, 1, max)
idx_minimax <- which.min(max_regret)
decision_minimax <- rownames(pagos)[idx_minimax]

# Mostrar tabla de arrepentimientos
regret_df <- as.data.frame(regret)
regret_df$`MAX REGRET` <- ifelse(
  seq_len(nrow(regret_df)) == idx_minimax,
  paste0(dollar(max_regret, prefix="$", big.mark=","), " ★"),
  dollar(max_regret, prefix="$", big.mark=",")
)

regret_df %>%
  mutate(across(1:3, ~ dollar(.x, prefix="$", big.mark=","))) %>%
  kbl(caption = "Tabla de Arrepentimientos (Regret) — Criterio Minimax Regret") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","bordered"),
                full_width = FALSE) %>%
  column_spec(5, bold = TRUE, color = "#e0b") %>%
  row_spec(idx_minimax, background = "#ff2")
Tabla de Arrepentimientos (Regret) — Criterio Minimax Regret
Demanda Baja Demanda Media Demanda Alta MAX REGRET
A1:Planta Grande $100,000 -$300,000 -$1,000,000 $100,000
A2:Planta Mediana -$50,000 -$400,000 -$800,000 -$50,000
A3:Planta Pequena -$200,000 -$350,000 -$680,000 -$200,000 ★
A4:No construir -$150,000 -$250,000 -$550,000 -$150,000

✅ Decisión Minimax Regret: A2 (Planta Mediana) con arrepentimiento máximo de $200,000. Minimiza el “dolor” de haber tomado la decisión equivocada.

2.6 Resumen de Criterios bajo Incertidumbre

resumen <- data.frame(
  Criterio   = c("Maximax", "Maximin (Wald)", "Hurwicz (α=0.6)",
                 "Laplace", "Minimax Regret"),
  Perfil     = c("Optimista puro", "Pesimista conservador",
                 "Moderado optimista", "Neutral / sin info",
                 "Minimiza pesar"),
  Decisión   = c("A1: Planta Grande", "A3: Planta Pequeña",
                 "A1: Planta Grande", "A2: Planta Mediana",
                 "A2: Planta Mediana"),
  Valor      = c("$500,000", "$100,000 (mín garantizado)",
                 "$220,000", "$150,000",
                 "$200,000 (regret máx)")
)

resumen %>%
  kbl(caption = "Resumen de Decisiones según Criterio") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","bordered"),
                full_width = TRUE) %>%
  column_spec(1, bold = TRUE) %>%
  column_spec(3, color = "#20b", bold = TRUE)
Resumen de Decisiones según Criterio
Criterio Perfil Decisión Valor
Maximax Optimista puro A1: Planta Grande $500,000
Maximin (Wald) Pesimista conservador A3: Planta Pequeña $100,000 (mín garantizado)
Hurwicz (α=0.6) Moderado optimista A1: Planta Grande $220,000
Laplace Neutral / sin info A2: Planta Mediana $150,000
Minimax Regret Minimiza pesar A2: Planta Mediana $200,000 (regret máx)

💡 Insight: Diferentes criterios dan diferentes decisiones. La elección del criterio depende del perfil de riesgo del decisor. No hay uno “correcto” universalmente.

3 Valor Esperado (Decisiones bajo Riesgo)

Contexto: Cuando conocemos (o estimamos) las probabilidades de cada estado de naturaleza.

3.1 Valor Monetario Esperado (VME)

Valor Monetario Esperado (VME / EMV): La media ponderada de todos los posibles resultados de una alternativa, donde los pesos son las probabilidades de cada estado.

VME(Aᵢ) = Σⱼ pⱼ · Vᵢⱼ donde Σⱼ pⱼ = 1

# Probabilidades estimadas por el equipo de marketing
prob <- c(0.20, 0.45, 0.35)   # P(Baja), P(Media), P(Alta)
names(prob) <- colnames(pagos)

cat("Probabilidades asignadas:\n")
## Probabilidades asignadas:
print(prob)
##  Demanda Baja Demanda Media  Demanda Alta 
##          0.20          0.45          0.35
# Cálculo del VME
vme <- pagos %*% prob
best_vme_idx <- which.max(vme)
decision_vme <- rownames(vme)[best_vme_idx]

# Tabla de cálculo detallado
vme_detalle <- as.data.frame(pagos)
vme_detalle$`p×V (Baja)`  <- pagos[, 1] * prob[1]
vme_detalle$`p×V (Media)` <- pagos[, 2] * prob[2]
vme_detalle$`p×V (Alta)`  <- pagos[, 3] * prob[3]
vme_detalle$VME <- as.vector(vme)

vme_detalle %>%
  mutate(
    across(1:3, ~ dollar(.x, prefix="$", big.mark=",")),
    across(4:6, ~ dollar(.x, prefix="$", big.mark=",")),
    VME = ifelse(
      seq_len(n()) == best_vme_idx,
      paste0(dollar(as.vector(vme), prefix="$", big.mark=","), " ★"),
      dollar(as.vector(vme), prefix="$", big.mark=",")
    )
  ) %>%
  kbl(caption = paste0("VME con p=(", paste(prob, collapse=", "), ")")) %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","bordered"),
                full_width = TRUE) %>%
  column_spec(7, bold = TRUE, color = "#98ae79") %>%
  row_spec(best_vme_idx, background = "#fafaf8")
VME con p=(0.2, 0.45, 0.35)
Demanda Baja Demanda Media Demanda Alta p×V (Baja) p×V (Media) p×V (Alta) VME
A1:Planta Grande -$200,000 $100,000 $500,000 -$40,000 $45,000 $175,000 $180,000
A2:Planta Mediana -$50,000 $200,000 $300,000 -$10,000 $90,000 $105,000 $185,000 ★
A3:Planta Pequena $100,000 $150,000 $180,000 $20,000 $67,500 $63,000 $150,500
A4:No construir $50,000 $50,000 $50,000 $10,000 $22,500 $17,500 $50,000 
cat("\n✅ Decisión VME:", decision_vme, "→ VME =", dollar(max(vme)))
## 
## ✅ Decisión VME: A2:Planta Mediana → VME = $185,000
vme_df <- data.frame(
  Alternativa = rownames(pagos),
  VME         = as.vector(vme)
)

ggplot(vme_df, aes(x = reorder(Alternativa, VME), y = VME,
                   fill = VME > 0)) +
  geom_col(width = 0.6, show.legend = FALSE) +
  geom_text(aes(label = dollar(VME, prefix="$", big.mark=",")),
            hjust = ifelse(vme_df$VME >= 0, -0.1, 1.1),
            size = 4, fontface = "bold") +
  geom_hline(yintercept = 0, color = "gray50", linewidth = 0.8) +
  scale_fill_manual(values = c("TRUE" = "#27a", "FALSE" = "#e74")) +
  scale_y_continuous(labels = dollar_format(prefix="$"),
                     limits = c(-100000, 250000)) +
  coord_flip() +
  labs(
    title    = "Valor Monetario Esperado (VME) por Alternativa",
    subtitle = "TechParts S.A. — p = (0.20, 0.45, 0.35)",
    x        = NULL,
    y        = "VME ($)"
  ) +
  theme_minimal(base_size = 13)

✅ Decisión VME: A2 (Planta Mediana) con VME = $185,000 es la que maximiza el retorno esperado.

3.2 Valor Esperado con Certeza Perfecta (VECP)

El VECP es lo que ganaríamos en promedio si supiéramos de antemano cuál estado va a ocurrir. Es el máximo teórico posible.

VECP = Σⱼ pⱼ · max_i(Vᵢⱼ)

# Para cada estado, la mejor alternativa posible
mejor_por_estado <- apply(pagos, 2, max)

vecp_df <- data.frame(
  Estado             = colnames(pagos),
  `Mejor Alternativa`= apply(pagos, 2, function(x) rownames(pagos)[which.max(x)]),
  `Mejor Valor`      = mejor_por_estado,
  `Probabilidad`     = prob,
  `Contribución`     = mejor_por_estado * prob,
  check.names        = FALSE
)

vecp_df %>%
  mutate(
    `Mejor Valor`  = dollar(`Mejor Valor`, prefix="$", big.mark=","),
    `Contribución` = dollar(`Contribución`, prefix="$", big.mark=",")
  ) %>%
  kbl(caption = "Cálculo del VECP") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","bordered"),
                full_width = FALSE) %>%
  column_spec(5, bold = TRUE, color = "#27ae60")
Cálculo del VECP
Estado Mejor Alternativa Mejor Valor Probabilidad Contribución
Demanda Baja Demanda Baja A3:Planta Pequena $100,000 0.20 $20,000
Demanda Media Demanda Media A2:Planta Mediana $200,000 0.45 $90,000
Demanda Alta Demanda Alta A1:Planta Grande $500,000 0.35 $175,000 
VECP <- sum(mejor_por_estado * prob)
cat("\nVECP =", dollar(VECP), "\n")
## 
## VECP = $285,000
cat("Cálculo: 0.20 ×", dollar(mejor_por_estado[1]),
    "+ 0.45 ×", dollar(mejor_por_estado[2]),
    "+ 0.35 ×", dollar(mejor_por_estado[3]), "=", dollar(VECP))
## Cálculo: 0.20 × $100,000 + 0.45 × $200,000 + 0.35 × $500,000 = $285,000

4 Valor Esperado de la Información Perfecta (VEIP)

El VEIP responde: “Si pudiera contratar a un adivino perfecto que me dijera exactamente qué estado va a ocurrir, ¿cuánto pagaría como máximo?”

VEIP = VECP − VME donde VME = max VME sin información adicional

VME_star <- max(vme)
VEIP     <- VECP - VME_star

cat("=== CÁLCULO DEL VEIP ===\n\n")
## === CÁLCULO DEL VEIP ===
cat("Paso 1 — VME* (sin información):", dollar(VME_star), "\n")
## Paso 1 — VME* (sin información): $185,000
cat("Paso 2 — VECP (con info perfecta):", dollar(VECP), "\n")
## Paso 2 — VECP (con info perfecta): $285,000
cat("Paso 3 — VEIP = VECP − VME* =",
    dollar(VECP), "−", dollar(VME_star), "=", dollar(VEIP), "\n")
## Paso 3 — VEIP = VECP − VME* = $285,000 − $185,000 = $100,000
veip_df <- data.frame(
  Concepto = c("VME* (sin información)", "VECP (info perfecta)", "VEIP (ganancia por info)"),
  Valor    = c(VME_star, VECP, VEIP),
  Tipo     = c("base", "perfecto", "ganancia")
)

ggplot(veip_df, aes(x = reorder(Concepto, Valor), y = Valor, fill = Tipo)) +
  geom_col(width = 0.55, show.legend = FALSE) +
  geom_text(aes(label = dollar(Valor, prefix="$", big.mark=",")),
            vjust = -0.5, size = 4.5, fontface = "bold") +
  scale_fill_manual(values = c("base" = "#349",
                               "perfecto" = "#27ae60",
                               "ganancia" = "#f39")) +
  scale_y_continuous(labels = dollar_format(prefix="$"),
                     limits = c(0, VECP * 1.2)) +
  labs(
    title    = "Análisis VEIP — TechParts S.A.",
    subtitle = "¿Cuánto vale pagar por información perfecta?",
    x        = NULL,
    y        = "Valor ($)"
  ) +
  theme_minimal(base_size = 13)

✅ Interpretación: TechParts S.A. debería pagar hasta $100,000 por un estudio de mercado perfecto. Si el estudio cuesta más, no vale la pena. Si cuesta menos, ¡es una buena inversión!

📌 VEII — Valor Esperado de la Información Imperfecta: En la práctica, la información nunca es perfecta. El VEII se calcula usando el Teorema de Bayes para actualizar probabilidades con la información parcial del estudio. VEII ≤ VEIP siempre.

5 Teorema de Bayes — Actualización de Creencias

El Teorema de Bayes nos permite actualizar probabilidades cuando recibimos nueva información. Transforma probabilidades a priori en probabilidades a posteriori.

P(Sⱼ | Indicador) = [P(Indicador | Sⱼ) · P(Sⱼ)] / P(Indicador)

P(Indicador) = Σⱼ P(Indicador | Sⱼ) · P(Sⱼ)

El flujo conceptual es:

Prior P(Sⱼ) → evidencia nueva → Posterior P(Sⱼ | E)

5.1 Caso con Bayes — TechParts S.A.

TechParts contrata una consultora que predice “Favorable” o “Desfavorable”. Las probabilidades de acierto de la consultora son:

# Probabilidades a priori
prior <- c(0.20, 0.45, 0.35)
names(prior) <- c("S1: Baja", "S2: Media", "S3: Alta")

# Verosimilitudes P(Indicador | Estado)
# Filas = indicador, columnas = estado
verosimilitud <- matrix(c(
  0.10, 0.40, 0.90,  # P(Favorable | S1, S2, S3)
  0.90, 0.60, 0.10   # P(Desfavorable | S1, S2, S3)
), nrow = 2, byrow = TRUE)
rownames(verosimilitud) <- c("Favorable", "Desfavorable")
colnames(verosimilitud) <- names(prior)

# Mostrar tabla de verosimilitudes + priors como fila adicional
veros_df <- as.data.frame(verosimilitud)

# Los priors pertenecen a los estados (columnas), se muestran como fila aparte
prior_row        <- as.data.frame(t(prior))
colnames(prior_row) <- colnames(veros_df)
rownames(prior_row) <- "Prior P(Estado)"

tabla_veros <- rbind(veros_df, prior_row)

tabla_veros %>%
  kbl(caption = "Verosimilitudes P(Indicador | Estado) y Probabilidades A Priori") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","bordered"),
                full_width = FALSE) %>%
  row_spec(nrow(tabla_veros), bold = TRUE, background = "#eaf", color = "#298") %>%
  add_header_above(c(" " = 1, "Estado de Naturaleza" = 3))
Verosimilitudes P(Indicador | Estado) y Probabilidades A Priori
Estado de Naturaleza
S1: Baja S2: Media S3: Alta
Favorable 0.1 0.40 0.90
Desfavorable 0.9 0.60 0.10
Prior P(Estado) 0.2 0.45 0.35

5.2 Función de Actualización Bayesiana

# Función para actualizar probabilidades con Bayes
bayes_update <- function(indicador_idx, prior, verosimilitud) {
  numeradores <- verosimilitud[indicador_idx, ] * prior
  P_indicador <- sum(numeradores)
  posterior   <- numeradores / P_indicador
  list(
    posterior   = posterior,
    P_indicador = P_indicador,
    numeradores = numeradores
  )
}

# ---- Si la consultora reporta FAVORABLE ----
res_fav <- bayes_update(1, prior, verosimilitud)

cat("=== Si la consultora reporta FAVORABLE ===\n\n")
## === Si la consultora reporta FAVORABLE ===
cat("P(Indicador = Favorable) =",
    paste(round(verosimilitud[1,] * prior, 4), collapse=" + "),
    "=", round(res_fav$P_indicador, 4), "\n\n")
## P(Indicador = Favorable) = 0.02 + 0.18 + 0.315 = 0.515
# Tabla detallada
tabla_fav <- data.frame(
  Estado         = names(prior),
  `P(F|S)`       = verosimilitud[1, ],
  `P(S)`         = prior,
  `P(F|S)×P(S)`  = res_fav$numeradores,
  `P(S|Favorable)` = round(res_fav$posterior, 4),
  check.names    = FALSE
)

tabla_fav %>%
  kbl(caption = "Actualización Bayesiana — Indicador Favorable") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","bordered"),
                full_width = FALSE) %>%
  column_spec(5, bold = TRUE, color = "#27a")
Actualización Bayesiana — Indicador Favorable
Estado P(F|S) P(S) P(F|S)×P(S) P(S|Favorable)
S1: Baja S1: Baja 0.1 0.20 0.020 0.0388
S2: Media S2: Media 0.4 0.45 0.180 0.3495
S3: Alta S3: Alta 0.9 0.35 0.315 0.6117 
# ---- Si la consultora reporta DESFAVORABLE ----
res_desf <- bayes_update(2, prior, verosimilitud)

tabla_desf <- data.frame(
  Estado            = names(prior),
  `P(D|S)`          = verosimilitud[2, ],
  `P(S)`            = prior,
  `P(D|S)×P(S)`     = res_desf$numeradores,
  `P(S|Desfavorable)` = round(res_desf$posterior, 4),
  check.names       = FALSE
)

tabla_desf %>%
  kbl(caption = "Actualización Bayesiana — Indicador Desfavorable") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed","bordered"),
                full_width = FALSE) %>%
  column_spec(5, bold = TRUE, color = "#e74c3c")
Actualización Bayesiana — Indicador Desfavorable
Estado P(D|S) P(S) P(D|S)×P(S) P(S|Desfavorable)
S1: Baja S1: Baja 0.9 0.20 0.180 0.3711
S2: Media S2: Media 0.6 0.45 0.270 0.5567
S3: Alta S3: Alta 0.1 0.35 0.035 0.0722

✅ Resultado: Si la consultora reporta “Favorable”, la probabilidad de demanda alta sube de 35% → 61.1%. Ahora recalculamos VME con estas nuevas probabilidades para decidir mejor.

5.3 Cálculo del VEII

# VME con información favorable
vme_fav  <- max(pagos %*% res_fav$posterior)
alt_fav  <- rownames(pagos)[which.max(pagos %*% res_fav$posterior)]

# VME con información desfavorable
vme_desf <- max(pagos %*% res_desf$posterior)
alt_desf <- rownames(pagos)[which.max(pagos %*% res_desf$posterior)]

# VME esperado con información imperfecta
VME_con_info <- res_fav$P_indicador * vme_fav + res_desf$P_indicador * vme_desf
VME_sin_info <- max(pagos %*% prior)
VEII         <- VME_con_info - VME_sin_info

cat("=== ANÁLISIS DE VALOR DE INFORMACIÓN ===\n\n")
## === ANÁLISIS DE VALOR DE INFORMACIÓN ===
cat("Si FAVORABLE  → mejor alternativa:", alt_fav,
    "→ VME =", dollar(round(vme_fav)), "\n")
## Si FAVORABLE  → mejor alternativa: A1:Planta Grande → VME = $333,010
cat("Si DESFAVORABLE → mejor alternativa:", alt_desf,
    "→ VME =", dollar(round(vme_desf)), "\n\n")
## Si DESFAVORABLE → mejor alternativa: A3:Planta Pequena → VME = $133,608
cat("P(Fav) =", round(res_fav$P_indicador, 3),
    "| P(Desf) =", round(res_desf$P_indicador, 3), "\n\n")
## P(Fav) = 0.515 | P(Desf) = 0.485
cat("VME sin información:        ", dollar(round(VME_sin_info)), "\n")
## VME sin información:         $185,000
cat("VME esperado con info:      ", dollar(round(VME_con_info)), "\n")
## VME esperado con info:       $236,300
cat("VEII (valor info imperfecta):", dollar(round(VEII)), "\n")
## VEII (valor info imperfecta): $51,300
cat("VEIP (máximo teórico):       ", dollar(round(VEIP)), "\n")
## VEIP (máximo teórico):        $100,000
cat("\nVerificación VEII ≤ VEIP:",
    round(VEII), "≤", round(VEIP), "→", VEII <= VEIP)
## 
## Verificación VEII ≤ VEIP: 51300 ≤ 1e+05 → TRUE

6 Árboles de Decisión

Una herramienta gráfica para modelar problemas con múltiples etapas de decisión. Los tres tipos de nodos son:

□ Nodo de Decisión (cuadrado): Representa una elección que controla el decisor.

○ Nodo de Azar (círculo): Representa eventos que controla la naturaleza, con probabilidades.

△ Nodo Terminal (hoja): El resultado final (payoff). Se evalúa de derecha a izquierda (backward induction).

6.1 Árbol de TechParts S.A.

# Construir los datos del árbol manualmente para visualizar con ggplot2
# Nodos (x, y, tipo, etiqueta)
nodos <- data.frame(
  x     = c(1, 3, 3, 3, 5, 5, 5, 5, 5, 5, 5, 5, 5),
  y     = c(5, 8, 5, 2, 9.5, 8, 6.5, 6, 5, 4, 3, 2, 1),
  tipo  = c("decision", "azar", "azar", "azar",
            "terminal","terminal","terminal",
            "terminal","terminal","terminal",
            "terminal","terminal","terminal"),
  label = c("D", "A1\nGrande", "A2\nMediana", "A3\nPequeña",
            "-$200k", "$100k", "$500k",
            "-$50k",  "$200k", "$300k",
            "$100k",  "$150k", "$180k"),
  vme   = c(NA, 180000, 185000, 150500, NA,NA,NA, NA,NA,NA, NA,NA,NA)
)

# Aristas (conexiones)
aristas <- data.frame(
  x1 = c(1,1,1, 3,3,3, 3,3,3, 3,3,3),
  y1 = c(5,5,5, 8,8,8, 5,5,5, 2,2,2),
  x2 = c(3,3,3, 5,5,5, 5,5,5, 5,5,5),
  y2 = c(8,5,2, 9.5,8,6.5, 6,5,4, 3,2,1),
  prob = c(NA,NA,NA, 0.20,0.45,0.35, 0.20,0.45,0.35, 0.20,0.45,0.35)
)

# Plot
ggplot() +
  # Aristas
  geom_segment(data = aristas,
               aes(x=x1, y=y1, xend=x2, yend=y2),
               color = "gray60", linewidth = 0.8,
               arrow = arrow(length = unit(0.2,"cm"), type="open")) +
  # Probabilidades en aristas (solo las que tienen)
  geom_text(data = aristas[!is.na(aristas$prob), ],
            aes(x = (x1+x2)/2 + 0.1, y = (y1+y2)/2 + 0.25,
                label = prob),
            size = 3, color = "#e67e22") +
  # Nodo de decisión (cuadrado)
  geom_point(data = nodos[nodos$tipo=="decision", ],
             aes(x=x, y=y), shape=15, size=8, color="#2980b9") +
  # Nodos de azar (círculo)
  geom_point(data = nodos[nodos$tipo=="azar", ],
             aes(x=x, y=y), shape=21, size=8,
             fill="#f39c12", color="white", stroke=1.5) +
  # VME sobre nodos de azar
  geom_text(data = nodos[nodos$tipo=="azar", ],
            aes(x=x+0.6, y=y, label=dollar(vme, prefix="$", big.mark=",")),
            size=3.2, color="#27ae60", fontface="bold") +
  # Nodos terminales (triángulo)
  geom_point(data = nodos[nodos$tipo=="terminal", ],
             aes(x=x, y=y), shape=24, size=4,
             fill="#27ae60", color="white") +
  # Etiquetas nodos
  geom_text(data = nodos,
            aes(x=x, y=y, label=label),
            size = ifelse(nodos$tipo=="terminal", 3, 2.8),
            color = ifelse(nodos$tipo=="terminal","#2c3e50","white"),
            fontface="bold",
            nudge_x = ifelse(nodos$tipo=="terminal", 0.55, 0),
            nudge_y = ifelse(nodos$tipo=="terminal", 0, 0)) +
  # Etiquetas de alternativas
  annotate("text", x=1.95, y=7.2,   label="A1: Grande",  color="#298", size=3.2, fontface="bold") +
  annotate("text", x=1.95, y=5,     label="A2: Mediana", color="#298", size=3.2, fontface="bold") +
  annotate("text", x=1.95, y=3.2,   label="A3: Pequeña", color="#298", size=3.2, fontface="bold") +
  # Leyenda nodos
  annotate("text", x=1.1, y=1.2, label="□ = Nodo Decisión", size=3, color="#2980b9") +
  annotate("text", x=1.1, y=0.8, label="○ = Nodo Azar",     size=3, color="#e67e22") +
  annotate("text", x=1.1, y=0.4, label="△ = Terminal",       size=3, color="#27ae60") +
  labs(
    title    = "Árbol de Decisión — TechParts S.A.",
    subtitle = "Backward induction: se evalúa de derecha a izquierda"
  ) +
  theme_void(base_size = 12) +
  theme(
    plot.title    = element_text(size=15, face="bold", color="#2c3e50"),
    plot.subtitle = element_text(size=11, color="gray40"),
    plot.margin   = margin(10, 20, 10, 10)
  )

🌿 Regla de Backward Induction: Siempre se resuelve el árbol de derecha a izquierda. En nodos de azar: calculamos VME. En nodos de decisión: elegimos la alternativa con mayor VME y “podamos” las demás.

7 Código R Completo

7.1 Criterios de Decisión (todo en uno)

# ================================================
# TEORÍA DE DECISIONES — R Completo
# ================================================

# Tabla de pagos (filas = alternativas, columnas = estados)
pagos <- matrix(c(
  -200000, 100000, 500000,  # A1: Planta Grande
   -50000, 200000, 300000,  # A2: Planta Mediana
   100000, 150000, 180000,  # A3: Planta Pequeña
    50000,  50000,  50000   # A4: No construir
), nrow = 4, byrow = TRUE)

rownames(pagos) <- c("Grande", "Mediana", "Pequeña", "NoConstr")
colnames(pagos) <- c("Baja", "Media", "Alta")

# ---- 1. MAXIMAX ----
max_fila  <- apply(pagos, 1, max)
maximax   <- names(which.max(max_fila))
cat("MAXIMAX  →", maximax, "($", max(max_fila), ")\n")
## MAXIMAX  → Grande ($ 5e+05 )
# ---- 2. MAXIMIN ----
min_fila  <- apply(pagos, 1, min)
maximin   <- names(which.max(min_fila))
cat("MAXIMIN  →", maximin, "($", max(min_fila), ")\n")
## MAXIMIN  → Pequeña ($ 1e+05 )
# ---- 3. HURWICZ (α = 0.6) ----
alpha     <- 0.6
H         <- alpha * max_fila + (1 - alpha) * min_fila
hurwicz   <- names(which.max(H))
cat("HURWICZ  →", hurwicz, "($", max(H), ")\n")
## HURWICZ  → Grande ($ 220000 )
# ---- 4. LAPLACE ----
laplace_vals <- rowMeans(pagos)
laplace      <- names(which.max(laplace_vals))
cat("LAPLACE  →", laplace, "($", max(laplace_vals), ")\n")
## LAPLACE  → Mediana ($ 150000 )
# ---- 5. MINIMAX REGRET ----
max_col    <- apply(pagos, 2, max)
regret     <- sweep(-pagos, 2, -max_col, "+")
max_regret <- apply(regret, 1, max)
minimax_r  <- names(which.min(max_regret))
cat("MINIMAX R→", minimax_r, "(regret $", min(max_regret), ")\n")
## MINIMAX R→ Pequeña (regret $ -2e+05 )
# ---- 6. VALOR ESPERADO (VME) ----
prob     <- c(0.20, 0.45, 0.35)
vme      <- pagos %*% prob
best_vme <- rownames(vme)[which.max(vme)]
cat("VME óptimo →", best_vme, "($", max(vme), ")\n")
## VME óptimo → Mediana ($ 185000 )
# ---- 7. VECP y VEIP ----
vecp <- sum(apply(pagos, 2, max) * prob)
veip <- vecp - max(vme)
cat("VECP = $", vecp, "| VEIP = $", veip, "\n")
## VECP = $ 285000 | VEIP = $ 1e+05
# ---- Visualización con ggplot2 ----
library(ggplot2)
library(scales)

df <- data.frame(
  Alternativa = rownames(vme),
  VME         = as.vector(vme)
)

ggplot(df, aes(x = Alternativa, y = VME, fill = VME)) +
  geom_col(show.legend = FALSE, width = 0.6) +
  scale_fill_gradient2(low = "#27a", mid = "#349",
                       high = "#e74c3c", midpoint = 0) +
  geom_hline(yintercept = 0, color = "white", linewidth = 0.5) +
  scale_y_continuous(labels = dollar_format(prefix = "$")) +
  labs(
    title    = "Valor Monetario Esperado por Alternativa",
    subtitle = "TechParts S.A. — p=(0.20, 0.45, 0.35)",
    y        = "VME ($)"
  ) +
  theme_minimal()

7.2 Teorema de Bayes y VEII

# ================================================
# TEOREMA DE BAYES — Actualización de Probabilidades
# ================================================

# Probabilidades a priori
prior <- c(0.20, 0.45, 0.35)  # P(S1), P(S2), P(S3)

# Verosimilitudes: P(Favorable | Estado)
verosimilitud <- matrix(c(
  0.10, 0.40, 0.90,  # P(Fav | S1, S2, S3)
  0.90, 0.60, 0.10   # P(Desf | S1, S2, S3)
), nrow = 2, byrow = TRUE)

rownames(verosimilitud) <- c("Favorable", "Desfavorable")
colnames(verosimilitud) <- c("Baja", "Media", "Alta")

bayes_update <- function(indicador_idx, prior, verosimilitud) {
  numeradores <- verosimilitud[indicador_idx, ] * prior
  P_indicador <- sum(numeradores)
  posterior   <- numeradores / P_indicador
  list(posterior = posterior, P_indicador = P_indicador)
}

# Actualizar dado resultado Favorable
res_fav <- bayes_update(1, prior, verosimilitud)
cat("\nSi consultora reporta FAVORABLE:\n")
## 
## Si consultora reporta FAVORABLE:
cat("P(Indicador) =", res_fav$P_indicador, "\n")
## P(Indicador) = 0.515
print(round(res_fav$posterior, 4))
##   Baja  Media   Alta 
## 0.0388 0.3495 0.6117
# Actualizar dado resultado Desfavorable
res_desf <- bayes_update(2, prior, verosimilitud)
cat("\nSi consultora reporta DESFAVORABLE:\n")
## 
## Si consultora reporta DESFAVORABLE:
cat("P(Indicador) =", res_desf$P_indicador, "\n")
## P(Indicador) = 0.485
print(round(res_desf$posterior, 4))
##   Baja  Media   Alta 
## 0.3711 0.5567 0.0722
# ---- VEII con árbol de decisión ----
vme_fav  <- max(pagos %*% res_fav$posterior)
vme_desf <- max(pagos %*% res_desf$posterior)

VME_con_info <- res_fav$P_indicador  * vme_fav +
                res_desf$P_indicador * vme_desf

VME_sin_info <- max(pagos %*% prior)
VEII         <- VME_con_info - VME_sin_info

cat("\n--- ANÁLISIS DE VALOR DE INFORMACIÓN ---\n")
## 
## --- ANÁLISIS DE VALOR DE INFORMACIÓN ---
cat("VME sin información:       $", round(VME_sin_info), "\n")
## VME sin información:       $ 185000
cat("VME esperado con info:     $", round(VME_con_info), "\n")
## VME esperado con info:     $ 236300
cat("VEII (valor info estudio): $", round(VEII), "\n")
## VEII (valor info estudio): $ 51300
cat("VEIP (máximo teórico):     $", round(vecp - VME_sin_info), "\n")
## VEIP (máximo teórico):     $ 1e+05