#SIMULACION MONTECARLO: RUTA SEGURA VS RUTA ARRIESGADA
#ETAPA 3
set.seed(2024)
n <- 5000
#Metas de cada ruta
metas <- c(RS = 11, RA = 12)
#Casillas especiales
casillas_especiales <- list(RS = c(4, 8),RA = c(3, 7, 10))
#Resultados posibles de la ruleta
sectores <- c("avanzar_2","retroceder_2","retroceder_2_rival","sin_efecto")
#Probabilidades de cada sector
probabilidades <- c(0.45, 0.20, 0.20, 0.15)
#---------------------------------------
#FUNCION PARA RESOLVER LOS MOVIMIENTOS
#---------------------------------------
resolver_movimiento <- function(estado, jugador, movimiento,
permitir_ficha = FALSE) {
rival <- if (jugador == "RS") "RA" else "RS"
posicion_anterior <- estado$pos[jugador]
#Cancelar retroceso cuando lo provoca el rival o la ruleta
if (movimiento < 0 && permitir_ficha) {
#Consultar exclusivamente la ficha del jugador afectado
if (isTRUE(estado$fichas[[jugador]]["cancelar_retroceso"])) {
#Consumir su propia ficha
estado$fichas[[jugador]]["cancelar_retroceso"] <- FALSE
#Cancelar el retroceso
movimiento <- 0
}
}
#Aplicar movimiento sin bajar de cero ni superar la meta
nueva_posicion <- max(
0,
min(posicion_anterior + movimiento, metas[jugador])
)
estado$pos[jugador] <- nueva_posicion
#Comprobar si el jugador alcanzo la meta
if (nueva_posicion >= metas[jugador]) {
estado$ganador <- jugador
return(estado)
}
#Comprobar si cayo exactamente en una casilla especial
if (nueva_posicion != posicion_anterior &&
nueva_posicion %in% casillas_especiales[[jugador]]) {
estado <- girar_ruleta(estado, jugador)
}
return(estado)
}
#---------------------------------------
# FUNCION PARA GIRAR LA RULETA
#---------------------------------------
girar_ruleta <- function(estado, jugador) {
rival <- if (jugador == "RS") "RA" else "RS"
#Seleccionar un resultado segun su probabilidad
resultado <- sample(
sectores,
size = 1,
prob = probabilidades
)
if (resultado == "avanzar_2") {
estado <- resolver_movimiento(
estado, jugador, 2
)
} else if (resultado == "retroceder_2") {
estado <- resolver_movimiento(
estado, jugador, -2,
permitir_ficha = TRUE
)
} else if (resultado == "retroceder_2_rival") {
estado <- resolver_movimiento(
estado, rival, -2,
permitir_ficha = TRUE
)
}
#Sin efecto: las posiciones permanecen iguales
return(estado)
}
#FUNCION PARA SIMULAR UNA PARTIDA
simular_partida <- function() {
#Lanzamiento inicial de ambos jugadores
repeat {
dado_1 <- sample(1:6, size = 1)
dado_2 <- sample(1:6, size = 1)
# Repetir si existe empate
if (dado_1 != dado_2) {
break
}
}
#Determinar quien comienza
if (dado_1 > dado_2) {
jugador_inicial <- "J1"
} else {
jugador_inicial <- "J2"
}
#El ganador elige aleatoriamente una ruta
ruta_inicial <- sample(c("RS", "RA"), size = 1)
#El otro jugador recibe la ruta restante
if (ruta_inicial == "RS") {
ruta_siguiente <- "RA"
} else {
ruta_siguiente <- "RS"
}
#Orden de los turnos
orden <- c(ruta_inicial, ruta_siguiente)
#Posiciones iniciales
posiciones <- c(RS = 0, RA = 0)
#Fichas disponibles para cada ruta
fichas <- list(
RS = c(
cancelar_retroceso = TRUE,
retroceder_2_rival = TRUE,
cancelar_turno = TRUE
),
RA = c(
cancelar_retroceso = TRUE,
retroceder_2_rival = TRUE,
cancelar_turno = TRUE
)
)
#Indicar si un jugador debe perder su proximo turno
saltar_turno <- c(RS = FALSE, RA = FALSE)
#Crear el estado inicial
estado <- list(
pos = posiciones,
fichas = fichas,
saltar = saltar_turno,
ganador = NA_character_
)
turnos <- 0
#La partida continua hasta que alguien alcance la meta
while (is.na(estado$ganador)) {
turnos <- turnos + 1
#Alternar los turnos
jugador <- orden[(turnos - 1) %% 2 + 1]
rival <- if (jugador == "RS") "RA" else "RS"
#Comprobar si debe perder este turno
if (estado$saltar[jugador]) {
estado$saltar[jugador] <- FALSE
next
}
#Lanzar el dado
dado <- sample(1:6, size = 1)
#Determinar el movimiento segun la ruta
if (jugador == "RS") {
if (dado == 6) {
movimiento <- 2
} else {
movimiento <- 1
}
} else {
if (dado %% 2 == 1) {
movimiento <- 3
} else {
movimiento <- -1
}
}
#Aplicar movimiento del dado
#No permite usar cancelar retroceso en este caso
estado <- resolver_movimiento(
estado,
jugador,
movimiento,
permitir_ficha = FALSE
)
#Comprobar si alguien gano
if (!is.na(estado$ganador)) {
break
}
#---------------------------------------
# FICHA: RETROCEDER 2 AL RIVAL
#---------------------------------------
distancia_rival <- metas[rival] - estado$pos[rival]
if (estado$fichas[[jugador]]["retroceder_2_rival"] &&
distancia_rival <= 2) {
#Consumir la ficha
estado$fichas[[jugador]]["retroceder_2_rival"] <- FALSE
# Hacer retroceder al rival
estado <- resolver_movimiento(
estado,
rival,
-2,
permitir_ficha = TRUE
)
}
#Comprobar si alguien gano
if (!is.na(estado$ganador)) {
break
}
#---------------------------------------
# FICHA: CANCELAR TURNO DEL RIVAL
#---------------------------------------
distancia_rival <- metas[rival] - estado$pos[rival]
if (estado$fichas[[jugador]]["cancelar_turno"] &&
distancia_rival <= 3) {
#Consumir la ficha
estado$fichas[[jugador]]["cancelar_turno"] <- FALSE
#El rival pierde su proximo turno
estado$saltar[rival] <- TRUE
}
}
#Retornar el ganador
return(estado$ganador)
}
#---------------------------------------
# SIMULACION DE LAS 5000 PARTIDAS
#---------------------------------------
resultados <- replicate(n, simular_partida())
#---------------------------------------
# CALCULO DE LOS RESULTADOS
#---------------------------------------
#Contar las victorias de cada ruta
victorias_RS <- sum(resultados == "RS")
victorias_RA <- sum(resultados == "RA")
#Calcular las probabilidades simuladas
probabilidad_RS <- victorias_RS / n
probabilidad_RA <- victorias_RA / n
#Mostrar resultados
cat("\n ---RESULTADOS DE MONTECARLO--- \n")
##
## ---RESULTADOS DE MONTECARLO---
cat("Partidas simuladas:", n, "\n")
## Partidas simuladas: 5000
cat("Victorias Ruta Segura:", victorias_RS, "\n")
## Victorias Ruta Segura: 2389
cat("Victorias Ruta Arriesgada:", victorias_RA, "\n")
## Victorias Ruta Arriesgada: 2611
cat("Probabilidad simulada RS:",round(probabilidad_RS, 4), "\n")
## Probabilidad simulada RS: 0.4778
cat("Probabilidad simulada RA:",round(probabilidad_RA, 4), "\n")
## Probabilidad simulada RA: 0.5222
#---------------------------------------
# GRAFICO DE CONVERGENCIA
#---------------------------------------
#Identificar las victorias de la Ruta Arriesgada
resultado_RA <- as.integer(resultados == "RA")
#Calcular la proporcion acumulada de victorias
nA_n <- cumsum(resultado_RA) / seq_len(n)
#Verificar que no existan valores no finitos
stopifnot(!any(!is.finite(nA_n)))
#Construir el grafico
plot(
nA_n,
type = "l",
xlab = "Numero de partidas",
ylab = "Probabilidad",
main = "Convergencia de victorias de la Ruta Arriesgada",
ylim = c(0, 1)
)
#Linea de referencia de la probabilidad simulada final
abline(
h = probabilidad_RA,
col = "red",
lty = 2
)
legend(
"bottomright",
legend = paste(
"Referencia simulada:",
round(probabilidad_RA, 4)
),
col = "red",
lty = 2
)
