Introduccion

El dia del cariño se aproxima y la empresa Tarjetas y mas, S.A. lo contrata para que determine la cantidad de tarjetas del dia del cariño que debe producir para maximizar su ganancia.

Ellos han determinado la siguientes probabilidades de demanda:

Demanda Probabilidad
10000 0.10
20000 0.35
40000 0.30
60000 0.25

Las tarjetas se venden a $4.00. El costo de producir una tarjeta es de $1.5. Las tarjetas que no se venden se mandan a reciclaje y las compran a $0.20 por tarjeta. Usted programará las siguientes producciones: 10,000 20,000 40,000 60,000

Conteste las siguientes preguntas:

1. Simule cada producción 1000 veces y obtenga un promedio de la ganancia.

Para realizar esto nos apoyamos en dos funciones: tarjetas.R y tc.R, la primera recibe como parametro la produccion y nos devuelve la ganancia:

tarjetas <- function(produccion=10000) {
  
#  Synopsis:  Recibe como parametro la produccion y regresa la ganancia 
# de acuerdo a los valores de demanda y produccion. Valor default 10,000

# Precios de venta y costos de produccion

pv <- 4 #precio de venta
cp <- 1.5 #costo de produccion
vr <- 0.2 #precio de venta tarjetas recicladas


#  Vector de probabilidad de demanda

prob_v <- c(0.1,0.35,0.3,0.25)

#  Demanda 

d <- c(10000,20000,40000,60000)

demanda <- sample(d,1,replace = T,prob_v)

if (produccion >= demanda) { Ganancia <- pv*demanda-cp*produccion+vr*(produccion-demanda)}
if (produccion < demanda) {Ganancia <- (pv-cp)*produccion -(pv-cp)*(demanda-produccion)}

return(Ganancia)

}

La segunda tc.R simula 1000 veces cada produccion:

tc <- function(P=10000) {
  
g <- rep(0,1000)

for (i in 1:1000){g[i] <- tarjetas(P)}

return(mean(g))

}

Con estas dos funciones podemos encontrar la ganacia promedio para cada produccion:

prod <- c(10000,20000,40000,60000)
prom <- sapply(prod,tc)
prom
## [1] -38175   6264  50948  57090

2. Grafique los promedios

plot(prod,prom, xlab = "Produccion", ylab = "Ganancia Promedio")

3. Mostrar las tablas de los resultados de cada simulación.

Nos auxiliamos con una funcion tc2.R , similar a tc.R pero que nos devuelve cada simulacion:

tc2 <- function(P=10000) {
  
  g <- rep(0,1000)
  
  for (i in 1:1000){g[i] <- tarjetas(P)}
  
  return(g)
  
}

Luego mostramos los 15 primeros resultados para cada produccion: 10,000 20,000 40,000 y 60,000:

# Calculamos las ganancias para cada produccion

g_10k <- tc2()
g_20k <- tc2(20000)
g_40k <- tc2(40000)
g_60k <- tc2(60000)

G <- cbind(g_10k,g_20k,g_40k,g_60k)

head(G,15)
##         g_10k  g_20k  g_40k  g_60k
##  [1,]       0      0 100000  -2000
##  [2,]       0  50000 100000  74000
##  [3,]  -50000  12000  24000 150000
##  [4,]  -50000      0  50000 -40000
##  [5,]       0  50000  50000  74000
##  [6,] -100000 -50000 100000  -2000
##  [7,]       0  50000  24000  74000
##  [8,]       0  12000  24000  74000
##  [9,] -100000  50000  24000 150000
## [10,]   25000  50000  50000  -2000
## [11,]   25000 -50000  24000 150000
## [12,]  -50000 -50000  50000 150000
## [13,]  -50000  12000  50000  -2000
## [14,]   25000 -50000  50000  -2000
## [15,]       0      0  24000 150000

4. Calcule la desviación estándar y grafique las desviaciones promedio.

Para este calculo nos apoyamos en la funcion tc3.R que devuelve la desviacion estandar de la ganancia para cada produccion:

tc3 <- function(P=10000) {
  
  g <- rep(0,1000)
  
  for (i in 1:1000){g[i] <- tarjetas(P)}

    s <- sd(g)
  return(s)
  
}

La desviacion estandar de cada produccion se calcula como:

desv <- sapply(prod,tc3)
desv
## [1] 42680.43 38317.96 36665.36 65904.74

Con esta misma funcion podemos generar vectores de desviaciones estandar de la ganancia para cada produccion. Vamos a usar 50 datos para calcular los promedios

desv_estandar <- data.frame(diez_mil=0,veinte_mil=0,cuarenta_mil=0,sesenta_mil=0)

for (i in 1:50){
  
  
  desv_estandar[i,] <- sapply(prod,tc3)
}
 desv_estandar
##    diez_mil veinte_mil cuarenta_mil sesenta_mil
## 1  43306.30   38500.39     37271.08    67046.23
## 2  43105.31   38791.11     36909.25    67212.24
## 3  44194.99   38553.68     36684.04    67149.76
## 4  43772.83   39510.98     36933.02    65516.80
## 5  43689.45   38250.41     37991.21    66547.73
## 6  43234.46   38724.26     37513.27    65031.31
## 7  43497.49   38040.16     37335.40    65222.00
## 8  43885.94   38156.78     37458.26    66288.32
## 9  43340.83   37480.45     37747.00    66111.90
## 10 43001.47   38671.16     37601.25    66245.65
## 11 44270.24   37805.00     36992.18    67540.60
## 12 44081.98   37404.49     37185.78    66365.78
## 13 43138.56   38371.30     37211.32    67337.41
## 14 43537.60   38874.18     37565.55    66450.28
## 15 44974.55   38125.69     37155.60    65461.53
## 16 43820.25   38148.05     37105.88    66557.21
## 17 43524.06   38850.90     37058.76    67459.92
## 18 43865.95   38084.76     37349.93    66592.46
## 19 43760.20   38903.69     36807.54    66831.23
## 20 42579.48   39190.50     36734.13    66002.19
## 21 44038.21   37806.36     38096.01    65255.47
## 22 43112.74   38368.96     37796.90    66021.84
## 23 43729.16   37833.97     37487.76    66581.69
## 24 44070.31   38249.12     36553.60    66654.16
## 25 43091.15   39073.70     38182.83    66278.60
## 26 44043.02   38919.71     38354.75    66454.97
## 27 44749.15   37835.32     37377.26    66276.03
## 28 43895.17   38651.58     36284.62    66661.54
## 29 43553.12   38449.58     37138.51    66544.78
## 30 44081.55   38318.06     37684.90    66519.92
## 31 43611.88   38583.50     37478.44    66936.26
## 32 43755.10   38778.84     36952.62    65172.89
## 33 43882.34   37953.96     38663.40    65600.50
## 34 44001.43   38738.26     37068.62    66236.24
## 35 43939.26   37683.82     36453.82    66979.27
## 36 44008.83   38424.92     38151.84    66518.07
## 37 43070.87   37890.80     37699.47    65420.45
## 38 43345.78   37401.49     37513.89    66270.09
## 39 43394.04   38906.47     38854.97    67127.24
## 40 43332.29   38891.09     37584.53    65921.93
## 41 44416.92   38192.00     37573.01    65888.43
## 42 43042.39   38763.00     37247.37    67619.32
## 43 43024.74   38404.36     37085.03    65193.46
## 44 44095.60   37521.04     36691.67    64666.30
## 45 44223.33   38003.71     36338.26    66691.80
## 46 43519.40   38374.72     37180.56    66787.37
## 47 43463.93   37630.65     36461.76    64700.10
## 48 44385.02   38626.36     35920.84    66678.36
## 49 42974.77   39211.24     37077.91    65734.41
## 50 42871.40   38872.98     37605.99    66589.86

Ahora graficamos las desviaciones estandar promedio para cada produccion:

sd_10k <- mean(desv_estandar$diez_mil)
sd_20k <- mean(desv_estandar$veinte_mil)
sd_40k <- mean(desv_estandar$cuarenta_mil)
sd_60k <- mean(desv_estandar$sesenta_mil)

sd_tot <- c(sd_10k,sd_20k,sd_40k,sd_60k)
sd_tot
## [1] 43666.10 38375.95 37303.43 66299.04
plot(prod,sd_tot, xlab = "Produccion", ylab="Desviacion Estandar Promedio")

5. Qué opción da la mayor ganancia pero el menos riesgo.

El riesgo se evalua en base a la probabilidad de perdida. Las dos opciones que dan la mayor ganancia son producciones de 40,000 y 60,000. La produccion de 40,000 tiene baja desviacion estandar por lo que la probabilidad de perder dinero en esta produccion es baja y representa el menor riesgo. La produccion de 40,000 da la mayor ganancia y el menor riesgo.

6. Qué opción da la mayor ganancia y el mayor riesgo

La produccion de 60,000 da la mayor ganancia , sin embargo tiene una desviacion estandard promedio similar a la ganacia promedio que se genera y por lo tanto es la opcion de mayor ganancia pero tambien la de mayor riesgo.