Comple SDP MAQUINAS

R Markdown

# SDP MAQUINAS ------------------------------------------------------------

epocas<-1:3

estados <- c('E','B','P','M')

desiciones <- c("Reemplazar", "No reemplazar")

ganancias_sem <-c(100,80,50,10)
names(ganancias_sem) <- c('E','B','P','M')


retornos<-function(i,a){
  
  if(a=='No reemplazar'){
    ret <- ganancias_sem[i]
  }else if(a=='Reemplazar' & i!='E'){
    ret <- 100-200
  }else{
    ret<--100000000
  }
  return(ret)
}

retornos('M','No reemplazar')

##  M 
## 10

retornos('M','Reemplazar')

## [1] -100

# Inicializar matrices
probs <- list()
for(n in epocas){
  probs[[n]] <- list()
  for(a in desiciones){
    
    if(a=='No reemplazar'){
      tabla <- c(0.7,0.3,0,0,
                 0,0.7,0.3,0,
                 0,0,0.6,0.4,
                 0,0,0,1)
    }else{
      tabla <- c(0.0,0.0,0,0,
                 0.7,0.3,0,0,
                 0.7,0.3,0,0,
                 0.7,0.3,0,0)
    }
    
    
    probs[[n]][[a]] <- matrix(tabla,byrow = TRUE, nrow = length(estados), ncol = length(estados),
                              dimnames = list(estados,estados))
  }
}

probs

## [[1]]
## [[1]]$Reemplazar
##     E   B P M
## E 0.0 0.0 0 0
## B 0.7 0.3 0 0
## P 0.7 0.3 0 0
## M 0.7 0.3 0 0
## 
## [[1]]$`No reemplazar`
##     E   B   P   M
## E 0.7 0.3 0.0 0.0
## B 0.0 0.7 0.3 0.0
## P 0.0 0.0 0.6 0.4
## M 0.0 0.0 0.0 1.0
## 
## 
## [[2]]
## [[2]]$Reemplazar
##     E   B P M
## E 0.0 0.0 0 0
## B 0.7 0.3 0 0
## P 0.7 0.3 0 0
## M 0.7 0.3 0 0
## 
## [[2]]$`No reemplazar`
##     E   B   P   M
## E 0.7 0.3 0.0 0.0
## B 0.0 0.7 0.3 0.0
## P 0.0 0.0 0.6 0.4
## M 0.0 0.0 0.0 1.0
## 
## 
## [[3]]
## [[3]]$Reemplazar
##     E   B P M
## E 0.0 0.0 0 0
## B 0.7 0.3 0 0
## P 0.7 0.3 0 0
## M 0.7 0.3 0 0
## 
## [[3]]$`No reemplazar`
##     E   B   P   M
## E 0.7 0.3 0.0 0.0
## B 0.0 0.7 0.3 0.0
## P 0.0 0.0 0.6 0.4
## M 0.0 0.0 0.0 1.0

# Matriz con los valores de las ecuaciones de Bellman
f_rec <- matrix(0,nrow = length(estados),ncol = length(epocas))
dimnames(f_rec) <- list(estados, epocas)
                            
# Matriz de decisiones óptimas
mat_dec <- matrix(0,nrow = length(estados), ncol = length(epocas))
dimnames(mat_dec) <- list(estados, epocas) 

# Óptimo en última epoca
for(i in estados){
  
  maximo <- -10000000
  for(a in desiciones){
    valor <- retornos(i,a)
    
    if(valor >= maximo){
      f_rec[i,length(epocas)] <- valor
      mat_dec[i,length(epocas)] <- a
      maximo <- valor
    }
  }
}

# Recursión
for(e in (length(epocas)-1):1){
  for(i in estados){

    maximo <- -100000
    for(a in desiciones){
      valor <- retornos(i, a)
      
      for(j in estados){
        valor <- valor + probs[[e]][[a]][i,j]*f_rec[j,e+1]
      }
      
      if(valor >= maximo){
        f_rec[i,e] <- valor
        mat_dec[i,e] <- a
        maximo <- valor
      }
    }
    
  }
}

f_rec

##       1   2   3
## E 281.1 194 100
## B 210.9 151  80
## P 108.4  84  50
## M  81.1  20  10

mat_dec

##   1               2               3              
## E "No reemplazar" "No reemplazar" "No reemplazar"
## B "No reemplazar" "No reemplazar" "No reemplazar"
## P "No reemplazar" "No reemplazar" "No reemplazar"
## M "Reemplazar"    "No reemplazar" "No reemplazar"

# Mapa de calor -----------------------------------------------------------
library(colorspace)
library(reshape2)
library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.1.3

library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

decisionesOptimasLista <- melt(mat_dec)
colnames(decisionesOptimasLista) <- c("Estado", "Época", "Decisión")
decisionesOptimasLista$Dec <- ifelse(decisionesOptimasLista$Decisión == "Reemplazar", 1, 0)
decisionesOptimasLista$Dec <- as.factor(decisionesOptimasLista$Dec)

fig <- plot_ly(colors = colorRamp(c("blue", "yellow", "red")),
               colorbar = list(title = "Decisión"),
               z = decisionesOptimasLista$Dec, type = "heatmap", 
               x = decisionesOptimasLista$Época, y = decisionesOptimasLista$Estado)
fig <- fig %>% layout(title = "",
                      xaxis = list(title = 'Época'),
                      yaxis = list(title = 'Estado'))
fig