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==