problema

Link al shinny app [https://elgranbyr.shinyapps.io/vendedor_periodicos/]

Un revendedor de periódico compra el periódico a un precio de 33 centavos cada uno y los vende a 50 centavos cada uno.

Un periódico que no es vendido al final del día puede ser vendido al reciclador de papel por 5 centavos cada uno.

Los periódicos se pueden comprar solo por bloques de 10. Es decir, se pueden compra 40, 50, 60 etc.

Hay tres tipos de días de noticia, “Excelente”, “Bueno” y “Malo”, con probabilidades de 0.35, 0.45 y 0.20 respectivamente.

La distribución de los periódicos demandados en cada uno de los tres tipos de días esta dado en la siguiente tabla,

##distribución de probabilidad de la demanda

demanda excelente bueno malo
40 .03 .1 .44
50 .05 .18 .22
60 .15 .40 .16
70 .20 .20 .12
80 .35 .08 .06
90 .15 .04 .00
10 .07 .00 .00

La ganancia = al ingreso por venta – costo de los periódicos – la ganancia perdida por exceso de demanda + la venta al reciclaje.

El problema es determinar el numero optimo de compra del revendedor de periódicos. Esto se debe lograr haciendo un simulación de la demandas de 20 días guardando record de la ganancia diaria.

Presentar también una grafica donde el eje x es el numero de periódicos comprados y el eje y es la ganancia promedio de los 20 días.

Primero incluiremos la librerias

library(dplyr)
library(ggplot2)

definimos nuestras variables globales

valor_costo_periodico<-30
valor_venta_periodico<-50
valor_recicla_periodico<-5
tipo_demanda <-c("Excelente", "Bueno", "Malo")
probabilidad_demanda<- c(0.35, 0.45, 0.2)
tipos_pedido<-c(40,50,60,70,80,90,100)
demanda_excelente <- c(0.03, 0.05, 0.15, 0.2, 0.35, 0.15, 0.07)
demanda_bueno <- c(0.1, 0.18, 0.4, 0.2, 0.08, 0.04, 0)
demanda_malo <- c(0.44, 0.22, 0.16, 0.12, 0.06, 0, 0)
dias_simulacion<- 40

Realizamos la operatorio para los tipos de pedido

#variable que define el size del max a iterar en la simulacion
diatipo<-numeric(dias_simulacion)
demanda_real<-numeric(dias_simulacion)
result<-NULL
Resultado_Final<-NULL
for  (x in tipos_pedido){
  utilidad <- 0
  
  for (d in 1:dias_simulacion) {
    # calculamos un sample basado en la probabilidad segun el dia que cambiara dia con dia
    diatipo[d]<- sample(tipo_demanda, size=1, replace = TRUE, prob=probabilidad_demanda) 
    
    #verificamos el tipo de pedido
    if(diatipo[d]=="Excelente")
    {
      demanda_real[d] <- sample(tipos_pedido, size=1, replace = TRUE, prob=demanda_excelente)
    }
    if(diatipo[d]=="Bueno")
    {
      demanda_real[d] <- sample(tipos_pedido, size=1, replace = TRUE, prob=demanda_bueno)
    }
    if(diatipo[d]=="Malo")
    {
      demanda_real[d] <- sample(tipos_pedido, size=1, replace = TRUE, prob=demanda_malo)
    }
    ganancias<-0
    #determinara la ganancia 
    if(demanda_real[d]<x)
    { 
      ganancias <- (demanda_real[d]*0.5)- (x*0.33)  + ((x-demanda_real[d])*0.05)
    } 
    if (demanda_real[d]==x)
    {
      ganancias <- (demanda_real[d]*0.5)-(x*0.33)
    }
    else if (demanda_real[d]>x){
      ganancias <- (x*(0.5-0.33))  - ((demanda_real[d]-x)*(0.5-0.33))
    }
    
    utilidad<-utilidad+ganancias 
    nuevo <- data.frame (dia=d,Compra=x,Clientes=demanda_real[d],Ganancia=ganancias)
    result <- rbind(result, nuevo) 
  } 
  utilidad <- utilidad/ 20
  a <- data.frame (Compra=x,Ganancia=utilidad)
  Resultado_Final <- rbind(Resultado_Final, a) 

}

Verificamos los resultados

print(result)
NA

ganancia acumulada segun tipo de pedido

print(Resultado_Final)
plot(Resultado_Final)+ lines(Resultado_Final$Compra ,Resultado_Final$Ganancia, col="blue" )
integer(0)

respuesta

en un ejercicio de 40 dias, la mejor opcion esta en una compra de lote tamaño de 70

LS0tDQp0aXRsZTogInByb2JsZW1hIGRlbCB2ZW5kZWRvciBkZSBwZXJpb2RpY29zIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KIyBwcm9ibGVtYQ0KTGluayBhbCBzaGlubnkgYXBwIA0KIVtodHRwczovL2VsZ3JhbmJ5ci5zaGlueWFwcHMuaW8vdmVuZGVkb3JfcGVyaW9kaWNvcy9dDQoNClVuIHJldmVuZGVkb3IgZGUgcGVyacOzZGljbyBjb21wcmEgZWwgcGVyacOzZGljbyBhIHVuIHByZWNpbyBkZSAzMyBjZW50YXZvcyBjYWRhIHVubw0KeSBsb3MgdmVuZGUgYSA1MCBjZW50YXZvcyBjYWRhIHVuby4NCg0KVW4gcGVyacOzZGljbyBxdWUgbm8gZXMgdmVuZGlkbyBhbCBmaW5hbCBkZWwgZMOtYSBwdWVkZSBzZXIgdmVuZGlkbyBhbCByZWNpY2xhZG9yIGRlDQpwYXBlbCBwb3IgNSBjZW50YXZvcyBjYWRhIHVuby4NCg0KTG9zIHBlcmnDs2RpY29zIHNlIHB1ZWRlbiBjb21wcmFyIHNvbG8gcG9yIGJsb3F1ZXMgZGUgMTAuIEVzIGRlY2lyLCBzZSBwdWVkZW4gY29tcHJhDQo0MCwgNTAsIDYwIGV0Yy4NCg0KSGF5IHRyZXMgdGlwb3MgZGUgZMOtYXMgZGUgbm90aWNpYSwg4oCcRXhjZWxlbnRl4oCdLCDigJxCdWVub+KAnSB5IOKAnE1hbG/igJ0sIGNvbiBwcm9iYWJpbGlkYWRlcyBkZQ0KMC4zNSwgMC40NSB5IDAuMjAgcmVzcGVjdGl2YW1lbnRlLg0KDQpMYSBkaXN0cmlidWNpw7NuIGRlIGxvcyBwZXJpw7NkaWNvcyBkZW1hbmRhZG9zIGVuIGNhZGEgdW5vIGRlIGxvcyB0cmVzIHRpcG9zIGRlIGTDrWFzDQplc3RhIGRhZG8gZW4gbGEgc2lndWllbnRlIHRhYmxhLA0KDQojI2Rpc3RyaWJ1Y2nDs24gZGUgcHJvYmFiaWxpZGFkIGRlIGxhIGRlbWFuZGENCg0KfGRlbWFuZGEgICB8ZXhjZWxlbnRlICAgfCBidWVubyAgfCAgbWFsbyB8DQp8LS0tfC0tLXwtLS18LS0tfA0KfDQwICAgfC4wMyAgIHwuMSAgIHwuNDQgICB8DQp8NTAgICB8LjA1ICAgfC4xOCAgIHwuMjIgICB8DQp8NjAgICB8LjE1ICAgfC40MCAgIHwuMTYgICB8DQp8NzAgICB8LjIwICAgfC4yMCAgIHwuMTIgICB8DQp8ODAgICB8LjM1ICAgfC4wOCAgIHwuMDYgICB8DQp8OTAgICB8LjE1ICAgfC4wNCAgIHwuMDAgICB8DQp8MTAgICB8LjA3ICAgfC4wMCAgIHwuMDAgICB8DQoNCg0KDQoNCkxhIGdhbmFuY2lhID0gYWwgaW5ncmVzbyBwb3IgdmVudGEg4oCTIGNvc3RvIGRlIGxvcyBwZXJpw7NkaWNvcyDigJMgbGEgZ2FuYW5jaWEgcGVyZGlkYSBwb3INCmV4Y2VzbyBkZSBkZW1hbmRhICsgbGEgdmVudGEgYWwgcmVjaWNsYWplLg0KDQpFbCBwcm9ibGVtYSBlcyBkZXRlcm1pbmFyIGVsIG51bWVybyBvcHRpbW8gZGUgY29tcHJhIGRlbCByZXZlbmRlZG9yIGRlDQpwZXJpw7NkaWNvcy4gRXN0byBzZSBkZWJlIGxvZ3JhciBoYWNpZW5kbyB1biBzaW11bGFjacOzbiBkZSBsYSBkZW1hbmRhcyBkZSAyMCBkw61hcw0KZ3VhcmRhbmRvIHJlY29yZCBkZSBsYSBnYW5hbmNpYSBkaWFyaWEuDQoNClByZXNlbnRhciB0YW1iacOpbiB1bmEgZ3JhZmljYSBkb25kZSBlbCBlamUgeCBlcyBlbCBudW1lcm8gZGUgcGVyacOzZGljb3MgY29tcHJhZG9zIHkNCmVsIGVqZSB5IGVzIGxhIGdhbmFuY2lhIHByb21lZGlvIGRlIGxvcyAyMCBkw61hcy4NCg0KDQpQcmltZXJvIGluY2x1aXJlbW9zIGxhIGxpYnJlcmlhcw0KYGBge3J9DQpsaWJyYXJ5KGRwbHlyKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KYGBgDQoNCmRlZmluaW1vcyBudWVzdHJhcyB2YXJpYWJsZXMgZ2xvYmFsZXMNCg0KYGBge3J9DQp2YWxvcl9jb3N0b19wZXJpb2RpY288LTMwDQp2YWxvcl92ZW50YV9wZXJpb2RpY288LTUwDQp2YWxvcl9yZWNpY2xhX3BlcmlvZGljbzwtNQ0KdGlwb19kZW1hbmRhIDwtYygiRXhjZWxlbnRlIiwgIkJ1ZW5vIiwgIk1hbG8iKQ0KcHJvYmFiaWxpZGFkX2RlbWFuZGE8LSBjKDAuMzUsIDAuNDUsIDAuMikNCnRpcG9zX3BlZGlkbzwtYyg0MCw1MCw2MCw3MCw4MCw5MCwxMDApDQpkZW1hbmRhX2V4Y2VsZW50ZSA8LSBjKDAuMDMsIDAuMDUsIDAuMTUsIDAuMiwgMC4zNSwgMC4xNSwgMC4wNykNCmRlbWFuZGFfYnVlbm8gPC0gYygwLjEsIDAuMTgsIDAuNCwgMC4yLCAwLjA4LCAwLjA0LCAwKQ0KZGVtYW5kYV9tYWxvIDwtIGMoMC40NCwgMC4yMiwgMC4xNiwgMC4xMiwgMC4wNiwgMCwgMCkNCmRpYXNfc2ltdWxhY2lvbjwtIDQwDQpgYGANCg0KUmVhbGl6YW1vcyBsYSBvcGVyYXRvcmlvIHBhcmEgbG9zIHRpcG9zIGRlIHBlZGlkbw0KDQpgYGB7cn0NCiN2YXJpYWJsZSBxdWUgZGVmaW5lIGVsIHNpemUgZGVsIG1heCBhIGl0ZXJhciBlbiBsYSBzaW11bGFjaW9uDQpkaWF0aXBvPC1udW1lcmljKGRpYXNfc2ltdWxhY2lvbikNCmRlbWFuZGFfcmVhbDwtbnVtZXJpYyhkaWFzX3NpbXVsYWNpb24pDQpyZXN1bHQ8LU5VTEwNClJlc3VsdGFkb19GaW5hbDwtTlVMTA0KZm9yICAoeCBpbiB0aXBvc19wZWRpZG8pew0KICB1dGlsaWRhZCA8LSAwDQogIA0KICBmb3IgKGQgaW4gMTpkaWFzX3NpbXVsYWNpb24pIHsNCiAgICAjIGNhbGN1bGFtb3MgdW4gc2FtcGxlIGJhc2FkbyBlbiBsYSBwcm9iYWJpbGlkYWQgc2VndW4gZWwgZGlhIHF1ZSBjYW1iaWFyYSBkaWEgY29uIGRpYQ0KICAgIGRpYXRpcG9bZF08LSBzYW1wbGUodGlwb19kZW1hbmRhLCBzaXplPTEsIHJlcGxhY2UgPSBUUlVFLCBwcm9iPXByb2JhYmlsaWRhZF9kZW1hbmRhKSANCiAgICANCiAgICAjdmVyaWZpY2Ftb3MgZWwgdGlwbyBkZSBwZWRpZG8NCiAgICBpZihkaWF0aXBvW2RdPT0iRXhjZWxlbnRlIikNCiAgICB7DQogICAgICBkZW1hbmRhX3JlYWxbZF0gPC0gc2FtcGxlKHRpcG9zX3BlZGlkbywgc2l6ZT0xLCByZXBsYWNlID0gVFJVRSwgcHJvYj1kZW1hbmRhX2V4Y2VsZW50ZSkNCiAgICB9DQogICAgaWYoZGlhdGlwb1tkXT09IkJ1ZW5vIikNCiAgICB7DQogICAgICBkZW1hbmRhX3JlYWxbZF0gPC0gc2FtcGxlKHRpcG9zX3BlZGlkbywgc2l6ZT0xLCByZXBsYWNlID0gVFJVRSwgcHJvYj1kZW1hbmRhX2J1ZW5vKQ0KICAgIH0NCiAgICBpZihkaWF0aXBvW2RdPT0iTWFsbyIpDQogICAgew0KICAgICAgZGVtYW5kYV9yZWFsW2RdIDwtIHNhbXBsZSh0aXBvc19wZWRpZG8sIHNpemU9MSwgcmVwbGFjZSA9IFRSVUUsIHByb2I9ZGVtYW5kYV9tYWxvKQ0KICAgIH0NCiAgICBnYW5hbmNpYXM8LTANCiAgICAjZGV0ZXJtaW5hcmEgbGEgZ2FuYW5jaWEgDQogICAgaWYoZGVtYW5kYV9yZWFsW2RdPHgpDQogICAgeyANCiAgICAgIGdhbmFuY2lhcyA8LSAoZGVtYW5kYV9yZWFsW2RdKjAuNSktICh4KjAuMzMpICArICgoeC1kZW1hbmRhX3JlYWxbZF0pKjAuMDUpDQogICAgfSANCiAgICBpZiAoZGVtYW5kYV9yZWFsW2RdPT14KQ0KICAgIHsNCiAgICAgIGdhbmFuY2lhcyA8LSAoZGVtYW5kYV9yZWFsW2RdKjAuNSktKHgqMC4zMykNCiAgICB9DQogICAgZWxzZSBpZiAoZGVtYW5kYV9yZWFsW2RdPngpew0KICAgICAgZ2FuYW5jaWFzIDwtICh4KigwLjUtMC4zMykpICAtICgoZGVtYW5kYV9yZWFsW2RdLXgpKigwLjUtMC4zMykpDQogICAgfQ0KICAgIA0KICAgIHV0aWxpZGFkPC11dGlsaWRhZCtnYW5hbmNpYXMgDQogICAgbnVldm8gPC0gZGF0YS5mcmFtZSAoZGlhPWQsQ29tcHJhPXgsQ2xpZW50ZXM9ZGVtYW5kYV9yZWFsW2RdLEdhbmFuY2lhPWdhbmFuY2lhcykNCiAgICByZXN1bHQgPC0gcmJpbmQocmVzdWx0LCBudWV2bykgDQogIH0gDQogIHV0aWxpZGFkIDwtIHV0aWxpZGFkLyAyMA0KICBhIDwtIGRhdGEuZnJhbWUgKENvbXByYT14LEdhbmFuY2lhPXV0aWxpZGFkKQ0KICBSZXN1bHRhZG9fRmluYWwgPC0gcmJpbmQoUmVzdWx0YWRvX0ZpbmFsLCBhKSANCg0KfSANCmBgYA0KVmVyaWZpY2Ftb3MgbG9zIHJlc3VsdGFkb3MNCmBgYHtyfQ0KcHJpbnQocmVzdWx0KQ0KDQpgYGANCg0KDQoNCmdhbmFuY2lhIGFjdW11bGFkYSBzZWd1biB0aXBvIGRlIHBlZGlkbyANCg0KYGBge3J9DQpwcmludChSZXN1bHRhZG9fRmluYWwpDQpgYGANCg0KDQoNCg0KYGBge3J9DQpwbG90KFJlc3VsdGFkb19GaW5hbCkrIGxpbmVzKFJlc3VsdGFkb19GaW5hbCRDb21wcmEgLFJlc3VsdGFkb19GaW5hbCRHYW5hbmNpYSwgY29sPSJibHVlIiApDQpgYGANCg0KIyByZXNwdWVzdGENCmVuIHVuIGVqZXJjaWNpbyBkZSA0MCBkaWFzLCBsYSBtZWpvciBvcGNpb24gZXN0YSBlbiB1bmEgY29tcHJhIGRlIGxvdGUgdGFtYcOxbyBkZSA3MA0K