In this lab we will focus on sensitivity analysis and Monte Carlo simulations.
Sensitivity analysis is the study of how the uncertainty in the output of a mathematical model or system (numerical or otherwise) can be apportioned to different sources of uncertainty in its inputs. We will use the lpSolveAPI R-package as we did in the previous lab.
Monte Carlo Simulations utilize repeated random sampling from a given universe or population to derive certain results. This type of simulation is known as a probabilistic simulation, as opposed to a deterministic simulation.
An example of a Monte Carlo simulation is the one applied to approximate the value of pi. The simulation is based on generating random points within a unit square and see how many points fall within the circle enclosed by the unit square (marked in red). The higher the number of sampled points the closer the result is to the actual result. After selecting 30,000 random points, the estimate for pi is much closer to the actual value within the four decimal points of precision.
In this lab, we will learn how to generate random samples with various simulations and how to run a sensitivity analysis on the marketing use case covered so far.
Remember to always set your working directory to the source file location. Go to ‘Session’, scroll down to ‘Set Working Directory’, and click ‘To Source File Location’. Read carefully the below and follow the instructions to complete the tasks and answer any questions. Submit your work to RPubs as detailed in previous notes.
For your assignment you may be using different data sets than what is included here. Always read carefully the instructions on Sakai. Tasks/questions to be completed/answered are highlighted in larger bolded fonts and numbered according to their particular placement in the task section.
In order to conduct the sensitivity analysis, we will need to download again the lpSolveAPI package unless you have it already installed in your R environment
# Require will load the package only if not installed
# Dependencies = TRUE makes sure that dependencies are install
if(!require("lpSolveAPI",quietly = TRUE))
install.packages("lpSolveAPI",dependencies = TRUE, repos = "https://cloud.r-project.org")
We will revisit and solve again the marketing case discussed in class (also part of previous lab).
# We start with `0` constraint and `2` decision variables. The object name `lpmark` is discretionary.
lpmark = make.lp(0, 2)
# Define type of optimization as maximum and dump the screen output into a `dummy` variable
dummy = lp.control(lpmark, sense="max")
# Set the objective function coefficients
set.objfn(lpmark, c(275.691, 48.341))
Add all constraints to the model.
add.constraint(lpmark, c(1, 1), "<=", 350000)
add.constraint(lpmark, c(1, 0), ">=", 15000)
add.constraint(lpmark, c(0, 1), ">=", 75000)
add.constraint(lpmark, c(2, -1), "=", 0)
add.constraint(lpmark, c(1, 0), ">=", 0)
add.constraint(lpmark, c(0, 1), ">=", 0)
Now, view the problem setting in tabular/matrix form. This is a good checkpoint to confirm that our contraints have been properly set.
lpmark
## Model name:
## C1 C2
## Maximize 275.691 48.341
## R1 1 1 <= 350000
## R2 1 0 >= 15000
## R3 0 1 >= 75000
## R4 2 -1 = 0
## R5 1 0 >= 0
## R6 0 1 >= 0
## Kind Std Std
## Type Real Real
## Upper Inf Inf
## Lower 0 0
# solve
solve(lpmark)
## [1] 0
Next we get the optimum results.
# display the objective function optimum value
get.objective(lpmark)
## [1] 43443517
# display the decision variables optimum values
get.variables(lpmark)
## [1] 116666.7 233333.3
For the sensitivity part we will add two new code sections to obtain the sensitivity results.
# display sensitivity to coefficients of objective function.
get.sensitivity.obj(lpmark)
## $objfrom
## [1] -96.6820 -137.8455
##
## $objtill
## [1] 1e+30 1e+30
objfrom. Explain in coincise manner what the sensitivity results represent in reference to the marketing model.The lower boundaries of the coefficient of radio and tv. The radio coefficeint lower boundary is -96.6820 and the tv coefficient lower boundary is -137.8455. The optimum solution will change when values go below these boundaries.
# display sensitivity to right hand side constraints.
# There will be a total of m+n values where m is the number of contraints and n is the number of decision variables
get.sensitivity.rhs(lpmark)
## $duals
## [1] 124.12433 0.00000 0.00000 75.78333 0.00000 0.00000 0.00000
## [8] 0.00000
##
## $dualsfrom
## [1] 1.125e+05 -1.000e+30 -1.000e+30 -3.050e+05 -1.000e+30 -1.000e+30
## [7] -1.000e+30 -1.000e+30
##
## $dualstill
## [1] 1.00e+30 1.00e+30 1.00e+30 4.75e+05 1.00e+30 1.00e+30 1.00e+30 1.00e+30
duals. Explain in coincise manner what the two non-zero sensitivity results represent. Distinguish the binding/non-binding constraints, the surplus/slack, and marginal values.Two non-zero: if the optimal solution is increased by 1, then the 1st and 4th variables increase by the value shown. These are binding constraints.
Binding constraints; when these change, then the optimum solution will change; these are the 1st & 4th contraints
Non-binding constraints; if these change, then the optimum solution will not change; these are the 2nd, 3rd, 5th, 6th, 7th, & 8th constraints.
Surplus/slack: The 2nd, 3rd, 5th, and 6th constraints are slack values since their constraints are less than or equal to, and the dual value is zero.
Marginal values: the marginal values are the 1st and 4th constraints since these are binding constraints. This shows the amount these variables will change when the optimum value is increased by 1.
To acquire a better understanding of the sensitivity results, and to confirm integrity of the calculations, independent tests can be conducted.
lpmark1. All being equal, change the budget constraint by only $1 and solve. Note the optimum value for sales as given by the objective function.# Define a new model object called lpmark1
lpmark1 = make.lp(0, 2)
# Repeat rest of commands with the one constraint change for budget. Solve and display the objective function optimum value
lpmark1 = make.lp(0, 2)
dummy = lp.control(lpmark1, sense="max")
set.objfn(lpmark1, c(275.691, 48.341))
Add all constraints to the model.
add.constraint(lpmark1, c(1, 1), "<=", 350001)
add.constraint(lpmark1, c(1, 0), ">=", 15000)
add.constraint(lpmark1, c(0, 1), ">=", 75000)
add.constraint(lpmark1, c(2, -1), "=", 0)
add.constraint(lpmark1, c(1, 0), ">=", 0)
add.constraint(lpmark1, c(0, 1), ">=", 0)
lpmark1
## Model name:
## C1 C2
## Maximize 275.691 48.341
## R1 1 1 <= 350001
## R2 1 0 >= 15000
## R3 0 1 >= 75000
## R4 2 -1 = 0
## R5 1 0 >= 0
## R6 0 1 >= 0
## Kind Std Std
## Type Real Real
## Upper Inf Inf
## Lower 0 0
solve(lpmark1)
## [1] 0
get.objective(lpmark1)
## [1] 43443641
get.variables(lpmark1)
## [1] 116667 233334
43443641 - 43443517 = 124 Sales increases by 124 when the budget constraint is changed by $1.
lpmark2.All being equal, change the constraint 2X1 - X2 = 0 by only $1 and solve. The new constraint will be 2X1 - X2 = 1. Note the optimum value for sales as given by the objective function.# Define a new model object called lpmark2
lpmark2 = make.lp(0, 2)
# Repeat rest of commands with the above constraint changed. Solve and display the objective function optimum value
# Define a new model object called lpmark1
lpmark2 = make.lp(0, 2)
# Repeat rest of commands with the one constraint change for budget. Solve and display the objective function optimum value
lpmark2 = make.lp(0, 2)
dummy = lp.control(lpmark2, sense="max")
set.objfn(lpmark2, c(275.691, 48.341))
Add all constraints to the model.
add.constraint(lpmark2, c(1, 1), "<=", 350000)
add.constraint(lpmark2, c(1, 0), ">=", 15000)
add.constraint(lpmark2, c(0, 1), ">=", 75000)
add.constraint(lpmark2, c(2, -1), "=", 1)
add.constraint(lpmark2, c(1, 0), ">=", 0)
add.constraint(lpmark2, c(0, 1), ">=", 0)
lpmark2
## Model name:
## C1 C2
## Maximize 275.691 48.341
## R1 1 1 <= 350000
## R2 1 0 >= 15000
## R3 0 1 >= 75000
## R4 2 -1 = 1
## R5 1 0 >= 0
## R6 0 1 >= 0
## Kind Std Std
## Type Real Real
## Upper Inf Inf
## Lower 0 0
solve(lpmark2)
## [1] 0
get.objective(lpmark2)
## [1] 43443592
get.variables(lpmark2)
## [1] 116667 233333
```
43443592 - 43443517 = 75 When the 4th constraint is changed from = 0 to = 1, sales rise by 75.
For this task we will be running a Monte Carlo simulation to calculate the probability that the daily return from S&P will be > 5%. We will assume that the historical S&P daily return follows a normal distribution with an average daily return of 0.03 (%) and a standard deviation of 0.97 (%).
To begin we will generate 100 random samples from the normal distribution. For the generated samples we will calculate the mean, standard deviation, and probability of occurrence where the simulation result is greater than 5%.
To generate random samples from a normal distribution we will use the rnorm() function in R. In the example below we set the number of runs (or samples) to 100.
runs = 100 # random number generator per defined normal distribution with given mean and standard deviation sims = rnorm(runs,mean=0.03,sd=0.97)
# number of simulations/samples
runs = 100
# random number generator per defined normal distribution with given mean and standard deviation
sims = rnorm(runs,mean=0.03,sd=0.97)
# Mean calculated from the random distribution of samples
average = mean(sims)
average
## [1] 0.01463598
# STD calculated from the random distribution of samples
std = sd(sims)
std
## [1] 0.8218597
# probability of occurrence on any given day based on samples will be equal to count (or sum) where sample result is greater than 5% divided by total number of samples.
prob = sum(sims >=0.05)/runs
prob
## [1] 0.48
runs1000 = 1000
sims1000 = rnorm(runs1000, mean=0.03, sd=0.97)
average1 = mean(sims1000)
average1
## [1] 0.00661545
std1 = sd(sims1000)
std1
## [1] 0.9492661
prob1 = sum(sims1000 >=0.05)/runs1000
prob1
## [1] 0.48
runs10000 = 10000
sims10000 = rnorm(runs10000, mean=0.03, sd=0.97)
average2 = mean(sims10000)
average2
## [1] 0.04948137
std2 = sd(sims10000)
std2
## [1] 0.9745133
prob2 = sum(sims10000 >=0.05)/runs10000
prob2
## [1] 0.4969
simulations <- matrix(c(average, average1, average2, std, std1, std2, prob, prob1, prob2), ncol=3)
colnames(simulations) <- c('Mean', 'Standard Deviation', 'Probability')
rownames(simulations) <- c('n=100', 'n=1000', 'n=10000')
simulations.table <- as.table(simulations)
simulations.table
## Mean Standard Deviation Probability
## n=100 0.01463598 0.82185972 0.48000000
## n=1000 0.00661545 0.94926615 0.48000000
## n=10000 0.04948137 0.97451326 0.49690000
pi that was presented in the introductory paragraph?The mean gets closer to the targeted mean of 0.03 as the number of runs increases. The standard deviation goes down and then up, and the probability increases and then decreases with more runs. The best bet on the probability of occurance greater than 5% would be the simulation with the most runs, 10,000. The more runs that are done, the closer the results are to reflect the actual large population. The image which calculated pi appeared more and more like the true value as there were more simulations with a higher ‘n’ being completed. The more simulations, the closer the values are to the true value of pi.
The last 2C) exercise is optional for those interested in further enhancing their subject matter learning, and refining their skills in R. Your work will be assessed but you will not be graded for this exercise. You can follow the instructions presented in the video Excel equivalent example at [https://www.youtube.com/watch?v=wKdmEXCvo9s]
mondaysims = rnorm(runs10000,mean=0.03,sd=0.97)
mondaymean = mean(mondaysims)
mondaymean
## [1] 0.02653115
tuesdaysims = rnorm(runs10000,mean=0.03,sd=0.97)
tuesdaymean = mean(tuesdaysims)
tuesdaymean
## [1] 0.03828521
wednesdaysims = rnorm(runs10000,mean=0.03,sd=0.97)
wednesdaymean = mean(wednesdaysims)
wednesdaymean
## [1] 0.03778528
thursdaysims = rnorm(runs10000,mean=0.03,sd=0.97)
thursdaymean = mean(thursdaysims)
thursdaymean
## [1] 0.04006915
fridaysims = rnorm(runs10000,mean=0.03,sd=0.97)
fridaymean = mean(fridaysims)
fridaymean
## [1] 0.03837111
weeklyreturn = (1+mondaysims)*(1+tuesdaysims)*(1+wednesdaysims)*(1+thursdaysims)*(1+fridaysims)-1
avgweeklyreturn = mean(weeklyreturn)
avgweeklyreturn
## [1] 0.166761
stdweeklyreturn = sd(weeklyreturn)
stdweeklyreturn
## [1] 5.568385
weeklyprob = sum(weeklyreturn >=0.05)/runs1000
weeklyprob
## [1] 2.611