Hacer click en la pestaña File. Seleccionar la opción New File. Seleccionar Shiny Web App. Poner nombre a la aplicación (e.j. ComplementariaShiny). En la opcion Application type, seleccionar Single File (app.R). Se recomienda guardar la aplicación en una carpeta de fácil acceso.

Si seleccionan el boton RunApp podran ver la aplicación y a lo que queremos llegar. Que dados unos parametros del usuario, el pueda ver como cambian graficas costos politicas, etc

Hay 3 principlaes componentes en Shiny

Una interfaz de usuario (ui) donde modificamos la apariencia y el diseño de la aplicacion. El server que contiene las instrucciones que le damos al computador para construir la aplicacion

Y finalmente la funcion ShinyApp que sirve para correr la aplicación.

Entonces, vamos a hacer el ejercicio adjunto, primero crearemos los modelos y despues la aplicación

Mientras que leen la complementaria, quiero mostrarles algo util cuando creen su aplicacion para el proyecto

library(shiny)
library(plotly)
library(markovchain)
source('CompSem4.R')

Primero vamos a crear la interfaz

# Definir la interfaz de usuario
ui <- fluidPage(
  #Titulo de la aplicación
  titlePanel('Aplicación politicas de inventario'),
  
  #Definir el recuadro de la aplicación
  sidebarLayout(
    
    #Agregar un panel lateral dentro del recuadro
    sidebarPanel(
      
      #Crear objeto para ingresar el parametro de la tasa de demanda con un control deslizante.
      sliderInput(inputId = 'TasaDemanda',
                  label = 'Tasa de demanda semanal (cajas/semana)',
                  min = 0,
                  max = 30,
                  value = 15)
    ),
    
    #Crear el panel principal para crear las graficas
    mainPanel(
      #Imprimir grafica de costos
      plotlyOutput(outputId = 'Graf_Cost_Tot')
    )
  )
)

MODELOS Y COSTOS DE POLITICA ACTUAL Y NUEVA


#Crear una funcion que reciba como parametro la tasa de demanda semanal
shiny_function = function(x){

  estados = c(0:22)
  
  #Crear y llenar la matriz P de la politica actual
  matrizP = matrix(0,nrow = length(estados), ncol = length(estados),
                   dimnames = list(estados,estados))
  
  #para la politica actual si i <= 10 solicito 12 resmas
  
  for (i in estados) {
    for (j in estados) {
      if (i<=10 & j > 0) {
        matrizP[i+1,j+1] = dpois(12+i-j,lambda = x)
      }
      if (i<=10 & j == 0) {
        matrizP[i+1,j+1] = ppois(12+i-1,lambda = x, lower.tail = F) 
      }
      if (i > 10 & j > 0) {
        matrizP[i+1,j+1] = dpois(i-j,lambda = x) 
      }
      if (i > 10 & j == 0) {
        matrizP[i+1,j+1] = ppois(i-1,lambda = x, lower.tail = F) 
      }
    }
  }
  
  #Crear la matriz P para la politica nueva
  matrizPnueva = matrix(nrow = length(estados),ncol = length(estados),
                        dimnames = list(estados,estados))
  
  for (i in estados) {
    for (j in estados) {
      if (j>0) {
        matrizPnueva[i+1,j+1] = dpois(22-j, lambda = x)
      }
      if (j == 0) {
        matrizPnueva[i+1,j+1] = ppois(21, lambda = x, lower.tail = F)
      }
    }
  }
  
  #Crear las cadenas usando la libreria markovchain
  
  cmtdActual = new("markovchain", states=as.character(estados), transitionMatrix=matrizP)
  cmtdNueva = new("markovchain", states=as.character(estados), transitionMatrix=matrizPnueva)
  
  #Valor de costos de inventario y costos de ordenar
  cInventario = 6200
  cOrdenar = 38000
  
  #----------------------------Estimar los costos para las proximas 10 semanas--------------#
  
  #Definir vector de condiciones iniciales
  #No hay unidades de inventario
  alpha = c(1,rep(0,length(estados)-1))
  
  
  #Vector de costos de la politica actual
  cost_sem_Pactual = c()
  for (i in 1:10) {
    probs = c()
    probs = alpha*(cmtdActual^i)
    cost_sem_Pactual[i] = cOrdenar + (cInventario*(probs%*%estados))
  }
  
  #Vector de costos para la politica nueva
  cost_sem_Pnueva = c()
  for (i in 1:10) {
    probs = c()
    probs = alpha*(cmtdNueva^i)
    cost_sem_Pnueva[i] = cOrdenar + (cInventario*(probs%*%estados))
  }
  
  #Vector de numero de semana
  num_sem = 1:10
  data = data.frame(num_sem,cost_sem_Pactual,cost_sem_Pnueva)
  
  return(data)

}

Ahora vamos a crear la logica detras de la aplicacion, es decir en el server

# Define server logic required to draw a histogram
server <- function(input, output) {
  #Se usan los corchetes {} para hacer que el contenido de nuestra funcion sea reactivo.
  output$Graf_Cost_Tot = renderPlotly({
    
    #Definir la informacion de costos
    InfoCostos = shiny_function(input$TasaDemanda)
    
    #Graficar la informacion de costos
    
    #Voy a usar la funcion plot_ly de la libreria que llamamos antes, donde entra como parametro la informacion,
    #que estara en el eje x, en el ele y, el nombre de la serie, el tipo de grafico y como s.e deben representar los 
    #datos
    
    plot_ly(InfoCostos, x = ~num_sem, y = ~cost_sem_Pactual, name = 'P.Actual', type = 'scatter',
            mode = 'lines+markers') %>%
      
      #Con el comando %>% añadimos una nueva serie de datos
      add_trace(y = ~cost_sem_Pnueva, name = 'P.nueva',mode = 'lines+markers') %>%
      
      #Con la funcion layout se etiqueta el grafico
      layout(title = 'Costo por politica en las proximas 10 semanas',
             xaxis = list(title = 'Semana'),
             yaxis = list(title = 'Costo'))
  })
}
LS0tDQp0aXRsZTogIlNuaW55Ig0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KSGFjZXIgY2xpY2sgZW4gbGEgcGVzdGHDsWEgRmlsZS4NClNlbGVjY2lvbmFyIGxhIG9wY2nDs24gTmV3IEZpbGUuDQpTZWxlY2Npb25hciBTaGlueSBXZWIgQXBwLg0KUG9uZXIgbm9tYnJlIGEgbGEgYXBsaWNhY2nDs24gKGUuai4gQ29tcGxlbWVudGFyaWFTaGlueSkuDQpFbiBsYSBvcGNpb24gQXBwbGljYXRpb24gdHlwZSwgc2VsZWNjaW9uYXIgU2luZ2xlIEZpbGUgKGFwcC5SKS4NClNlIHJlY29taWVuZGEgZ3VhcmRhciBsYSBhcGxpY2FjacOzbiBlbiB1bmEgY2FycGV0YSBkZSBmw6FjaWwgYWNjZXNvLg0KDQoNClNpIHNlbGVjY2lvbmFuIGVsIGJvdG9uIFJ1bkFwcCBwb2RyYW4gdmVyIGxhIGFwbGljYWNpw7NuIHkgYSBsbyBxdWUgcXVlcmVtb3MgbGxlZ2FyLg0KUXVlIGRhZG9zIHVub3MgcGFyYW1ldHJvcyBkZWwgdXN1YXJpbywgZWwgcHVlZGEgdmVyIGNvbW8gY2FtYmlhbiBncmFmaWNhcyBjb3N0b3MgcG9saXRpY2FzLCBldGMNCg0KSGF5IDMgcHJpbmNpcGxhZXMgY29tcG9uZW50ZXMgZW4gU2hpbnkNCg0KDQpVbmEgaW50ZXJmYXogZGUgdXN1YXJpbyAodWkpIGRvbmRlIG1vZGlmaWNhbW9zIGxhIGFwYXJpZW5jaWEgeSBlbCBkaXNlw7FvIGRlIGxhIGFwbGljYWNpb24uDQpFbCBzZXJ2ZXIgcXVlIGNvbnRpZW5lIGxhcyBpbnN0cnVjY2lvbmVzIHF1ZSBsZSBkYW1vcyBhbCBjb21wdXRhZG9yIHBhcmEgY29uc3RydWlyIGxhIA0KYXBsaWNhY2lvbg0KDQpZIGZpbmFsbWVudGUgbGEgZnVuY2lvbiBTaGlueUFwcCBxdWUgc2lydmUgcGFyYSBjb3JyZXIgbGEgYXBsaWNhY2nDs24uDQoNCg0KRW50b25jZXMsIHZhbW9zIGEgaGFjZXIgZWwgZWplcmNpY2lvIGFkanVudG8sIHByaW1lcm8gY3JlYXJlbW9zIGxvcyBtb2RlbG9zIHkgZGVzcHVlcyBsYSBhcGxpY2FjacOzbg0KDQpNaWVudHJhcyBxdWUgbGVlbiBsYSBjb21wbGVtZW50YXJpYSwgcXVpZXJvIG1vc3RyYXJsZXMgYWxnbyB1dGlsIGN1YW5kbyBjcmVlbiBzdSBhcGxpY2FjaW9uDQpwYXJhIGVsIHByb3llY3RvDQoNCg0KDQpgYGB7cn0NCmxpYnJhcnkoc2hpbnkpDQpsaWJyYXJ5KHBsb3RseSkNCmxpYnJhcnkobWFya292Y2hhaW4pDQpzb3VyY2UoJ0NvbXBTZW00LlInKQ0KYGBgDQoNCg0KUHJpbWVybyB2YW1vcyBhIGNyZWFyIGxhIGludGVyZmF6DQoNCg0KYGBge3J9DQojIERlZmluaXIgbGEgaW50ZXJmYXogZGUgdXN1YXJpbw0KdWkgPC0gZmx1aWRQYWdlKA0KICAjVGl0dWxvIGRlIGxhIGFwbGljYWNpw7NuDQogIHRpdGxlUGFuZWwoJ0FwbGljYWNpw7NuIHBvbGl0aWNhcyBkZSBpbnZlbnRhcmlvJyksDQogIA0KICAjRGVmaW5pciBlbCByZWN1YWRybyBkZSBsYSBhcGxpY2FjacOzbg0KICBzaWRlYmFyTGF5b3V0KA0KICAgIA0KICAgICNBZ3JlZ2FyIHVuIHBhbmVsIGxhdGVyYWwgZGVudHJvIGRlbCByZWN1YWRybw0KICAgIHNpZGViYXJQYW5lbCgNCiAgICAgIA0KICAgICAgI0NyZWFyIG9iamV0byBwYXJhIGluZ3Jlc2FyIGVsIHBhcmFtZXRybyBkZSBsYSB0YXNhIGRlIGRlbWFuZGEgY29uIHVuIGNvbnRyb2wgZGVzbGl6YW50ZS4NCiAgICAgIHNsaWRlcklucHV0KGlucHV0SWQgPSAnVGFzYURlbWFuZGEnLA0KICAgICAgICAgICAgICAgICAgbGFiZWwgPSAnVGFzYSBkZSBkZW1hbmRhIHNlbWFuYWwgKGNhamFzL3NlbWFuYSknLA0KICAgICAgICAgICAgICAgICAgbWluID0gMCwNCiAgICAgICAgICAgICAgICAgIG1heCA9IDMwLA0KICAgICAgICAgICAgICAgICAgdmFsdWUgPSAxNSkNCiAgICApLA0KICAgIA0KICAgICNDcmVhciBlbCBwYW5lbCBwcmluY2lwYWwgcGFyYSBjcmVhciBsYXMgZ3JhZmljYXMNCiAgICBtYWluUGFuZWwoDQogICAgICAjSW1wcmltaXIgZ3JhZmljYSBkZSBjb3N0b3MNCiAgICAgIHBsb3RseU91dHB1dChvdXRwdXRJZCA9ICdHcmFmX0Nvc3RfVG90JykNCiAgICApDQogICkNCikNCg0KYGBgDQoNCk1PREVMT1MgWSBDT1NUT1MgREUgUE9MSVRJQ0EgQUNUVUFMIFkgTlVFVkENCg0KYGBge3J9DQoNCiNDcmVhciB1bmEgZnVuY2lvbiBxdWUgcmVjaWJhIGNvbW8gcGFyYW1ldHJvIGxhIHRhc2EgZGUgZGVtYW5kYSBzZW1hbmFsDQpzaGlueV9mdW5jdGlvbiA9IGZ1bmN0aW9uKHgpew0KDQogIGVzdGFkb3MgPSBjKDA6MjIpDQogIA0KICAjQ3JlYXIgeSBsbGVuYXIgbGEgbWF0cml6IFAgZGUgbGEgcG9saXRpY2EgYWN0dWFsDQogIG1hdHJpelAgPSBtYXRyaXgoMCxucm93ID0gbGVuZ3RoKGVzdGFkb3MpLCBuY29sID0gbGVuZ3RoKGVzdGFkb3MpLA0KICAgICAgICAgICAgICAgICAgIGRpbW5hbWVzID0gbGlzdChlc3RhZG9zLGVzdGFkb3MpKQ0KICANCiAgI3BhcmEgbGEgcG9saXRpY2EgYWN0dWFsIHNpIGkgPD0gMTAgc29saWNpdG8gMTIgcmVzbWFzDQogIA0KICBmb3IgKGkgaW4gZXN0YWRvcykgew0KICAgIGZvciAoaiBpbiBlc3RhZG9zKSB7DQogICAgICBpZiAoaTw9MTAgJiBqID4gMCkgew0KICAgICAgICBtYXRyaXpQW2krMSxqKzFdID0gZHBvaXMoMTIraS1qLGxhbWJkYSA9IHgpDQogICAgICB9DQogICAgICBpZiAoaTw9MTAgJiBqID09IDApIHsNCiAgICAgICAgbWF0cml6UFtpKzEsaisxXSA9IHBwb2lzKDEyK2ktMSxsYW1iZGEgPSB4LCBsb3dlci50YWlsID0gRikgDQogICAgICB9DQogICAgICBpZiAoaSA+IDEwICYgaiA+IDApIHsNCiAgICAgICAgbWF0cml6UFtpKzEsaisxXSA9IGRwb2lzKGktaixsYW1iZGEgPSB4KSANCiAgICAgIH0NCiAgICAgIGlmIChpID4gMTAgJiBqID09IDApIHsNCiAgICAgICAgbWF0cml6UFtpKzEsaisxXSA9IHBwb2lzKGktMSxsYW1iZGEgPSB4LCBsb3dlci50YWlsID0gRikgDQogICAgICB9DQogICAgfQ0KICB9DQogIA0KICAjQ3JlYXIgbGEgbWF0cml6IFAgcGFyYSBsYSBwb2xpdGljYSBudWV2YQ0KICBtYXRyaXpQbnVldmEgPSBtYXRyaXgobnJvdyA9IGxlbmd0aChlc3RhZG9zKSxuY29sID0gbGVuZ3RoKGVzdGFkb3MpLA0KICAgICAgICAgICAgICAgICAgICAgICAgZGltbmFtZXMgPSBsaXN0KGVzdGFkb3MsZXN0YWRvcykpDQogIA0KICBmb3IgKGkgaW4gZXN0YWRvcykgew0KICAgIGZvciAoaiBpbiBlc3RhZG9zKSB7DQogICAgICBpZiAoaj4wKSB7DQogICAgICAgIG1hdHJpelBudWV2YVtpKzEsaisxXSA9IGRwb2lzKDIyLWosIGxhbWJkYSA9IHgpDQogICAgICB9DQogICAgICBpZiAoaiA9PSAwKSB7DQogICAgICAgIG1hdHJpelBudWV2YVtpKzEsaisxXSA9IHBwb2lzKDIxLCBsYW1iZGEgPSB4LCBsb3dlci50YWlsID0gRikNCiAgICAgIH0NCiAgICB9DQogIH0NCiAgDQogICNDcmVhciBsYXMgY2FkZW5hcyB1c2FuZG8gbGEgbGlicmVyaWEgbWFya292Y2hhaW4NCiAgDQogIGNtdGRBY3R1YWwgPSBuZXcoIm1hcmtvdmNoYWluIiwgc3RhdGVzPWFzLmNoYXJhY3Rlcihlc3RhZG9zKSwgdHJhbnNpdGlvbk1hdHJpeD1tYXRyaXpQKQ0KICBjbXRkTnVldmEgPSBuZXcoIm1hcmtvdmNoYWluIiwgc3RhdGVzPWFzLmNoYXJhY3Rlcihlc3RhZG9zKSwgdHJhbnNpdGlvbk1hdHJpeD1tYXRyaXpQbnVldmEpDQogIA0KICAjVmFsb3IgZGUgY29zdG9zIGRlIGludmVudGFyaW8geSBjb3N0b3MgZGUgb3JkZW5hcg0KICBjSW52ZW50YXJpbyA9IDYyMDANCiAgY09yZGVuYXIgPSAzODAwMA0KICANCiAgIy0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS1Fc3RpbWFyIGxvcyBjb3N0b3MgcGFyYSBsYXMgcHJveGltYXMgMTAgc2VtYW5hcy0tLS0tLS0tLS0tLS0tIw0KICANCiAgI0RlZmluaXIgdmVjdG9yIGRlIGNvbmRpY2lvbmVzIGluaWNpYWxlcw0KICAjTm8gaGF5IHVuaWRhZGVzIGRlIGludmVudGFyaW8NCiAgYWxwaGEgPSBjKDEscmVwKDAsbGVuZ3RoKGVzdGFkb3MpLTEpKQ0KICANCiAgDQogICNWZWN0b3IgZGUgY29zdG9zIGRlIGxhIHBvbGl0aWNhIGFjdHVhbA0KICBjb3N0X3NlbV9QYWN0dWFsID0gYygpDQogIGZvciAoaSBpbiAxOjEwKSB7DQogICAgcHJvYnMgPSBjKCkNCiAgICBwcm9icyA9IGFscGhhKihjbXRkQWN0dWFsXmkpDQogICAgY29zdF9zZW1fUGFjdHVhbFtpXSA9IGNPcmRlbmFyICsgKGNJbnZlbnRhcmlvKihwcm9icyUqJWVzdGFkb3MpKQ0KICB9DQogIA0KICAjVmVjdG9yIGRlIGNvc3RvcyBwYXJhIGxhIHBvbGl0aWNhIG51ZXZhDQogIGNvc3Rfc2VtX1BudWV2YSA9IGMoKQ0KICBmb3IgKGkgaW4gMToxMCkgew0KICAgIHByb2JzID0gYygpDQogICAgcHJvYnMgPSBhbHBoYSooY210ZE51ZXZhXmkpDQogICAgY29zdF9zZW1fUG51ZXZhW2ldID0gY09yZGVuYXIgKyAoY0ludmVudGFyaW8qKHByb2JzJSolZXN0YWRvcykpDQogIH0NCiAgDQogICNWZWN0b3IgZGUgbnVtZXJvIGRlIHNlbWFuYQ0KICBudW1fc2VtID0gMToxMA0KICBkYXRhID0gZGF0YS5mcmFtZShudW1fc2VtLGNvc3Rfc2VtX1BhY3R1YWwsY29zdF9zZW1fUG51ZXZhKQ0KICANCiAgcmV0dXJuKGRhdGEpDQoNCn0NCg0KYGBgDQoNCg0KQWhvcmEgdmFtb3MgYSBjcmVhciBsYSBsb2dpY2EgZGV0cmFzIGRlIGxhIGFwbGljYWNpb24sIGVzIGRlY2lyIGVuIGVsIHNlcnZlcg0KDQpgYGB7cn0NCiMgRGVmaW5lIHNlcnZlciBsb2dpYyByZXF1aXJlZCB0byBkcmF3IGEgaGlzdG9ncmFtDQpzZXJ2ZXIgPC0gZnVuY3Rpb24oaW5wdXQsIG91dHB1dCkgew0KICAjU2UgdXNhbiBsb3MgY29yY2hldGVzIHt9IHBhcmEgaGFjZXIgcXVlIGVsIGNvbnRlbmlkbyBkZSBudWVzdHJhIGZ1bmNpb24gc2VhIHJlYWN0aXZvLg0KICBvdXRwdXQkR3JhZl9Db3N0X1RvdCA9IHJlbmRlclBsb3RseSh7DQogICAgDQogICAgI0RlZmluaXIgbGEgaW5mb3JtYWNpb24gZGUgY29zdG9zDQogICAgSW5mb0Nvc3RvcyA9IHNoaW55X2Z1bmN0aW9uKGlucHV0JFRhc2FEZW1hbmRhKQ0KICAgIA0KICAgICNHcmFmaWNhciBsYSBpbmZvcm1hY2lvbiBkZSBjb3N0b3MNCiAgICANCiAgICAjVm95IGEgdXNhciBsYSBmdW5jaW9uIHBsb3RfbHkgZGUgbGEgbGlicmVyaWEgcXVlIGxsYW1hbW9zIGFudGVzLCBkb25kZSBlbnRyYSBjb21vIHBhcmFtZXRybyBsYSBpbmZvcm1hY2lvbiwNCiAgICAjcXVlIGVzdGFyYSBlbiBlbCBlamUgeCwgZW4gZWwgZWxlIHksIGVsIG5vbWJyZSBkZSBsYSBzZXJpZSwgZWwgdGlwbyBkZSBncmFmaWNvIHkgY29tbyBzLmUgZGViZW4gcmVwcmVzZW50YXIgbG9zIA0KICAgICNkYXRvcw0KICAgIA0KICAgIHBsb3RfbHkoSW5mb0Nvc3RvcywgeCA9IH5udW1fc2VtLCB5ID0gfmNvc3Rfc2VtX1BhY3R1YWwsIG5hbWUgPSAnUC5BY3R1YWwnLCB0eXBlID0gJ3NjYXR0ZXInLA0KICAgICAgICAgICAgbW9kZSA9ICdsaW5lcyttYXJrZXJzJykgJT4lDQogICAgICANCiAgICAgICNDb24gZWwgY29tYW5kbyAlPiUgYcOxYWRpbW9zIHVuYSBudWV2YSBzZXJpZSBkZSBkYXRvcw0KICAgICAgYWRkX3RyYWNlKHkgPSB+Y29zdF9zZW1fUG51ZXZhLCBuYW1lID0gJ1AubnVldmEnLG1vZGUgPSAnbGluZXMrbWFya2VycycpICU+JQ0KICAgICAgDQogICAgICAjQ29uIGxhIGZ1bmNpb24gbGF5b3V0IHNlIGV0aXF1ZXRhIGVsIGdyYWZpY28NCiAgICAgIGxheW91dCh0aXRsZSA9ICdDb3N0byBwb3IgcG9saXRpY2EgZW4gbGFzIHByb3hpbWFzIDEwIHNlbWFuYXMnLA0KICAgICAgICAgICAgIHhheGlzID0gbGlzdCh0aXRsZSA9ICdTZW1hbmEnKSwNCiAgICAgICAgICAgICB5YXhpcyA9IGxpc3QodGl0bGUgPSAnQ29zdG8nKSkNCiAgfSkNCn0NCmBgYA0KDQoNCg0KDQoNCg==