Im vorherigen Post habe ich die Monte-Carlo-Simulation vorgestellt und in den Kontext zur Planung unter Unsicherheit gestellt. Man kann den Spieß aber auch umdrehen und die bereits festgezurrte Planung neuen Gegebenheiten gegenüberstellen. Ergebnis ist eine Wahrscheinlichkeit, zu welcher die Planung getroffen werden kann.
Im Biespiel geht es wieder um einen Zweiproduktfall. Für beide Produkte ist ein Planwert des Umsatzes festgelegt, welchem die unsichere Umgebung gegenübergesetzt wird:
Die Aufmachung ist relativ einfach. Die Monte-Carlo-Simulation berechnet die n-vielen Ergebnisse. Diese Ergebnisse werden der Planung gegenübergestellt und gezählt, in wie vielen Fällen der Plan realisiert wird. Dieser Wert wird auch als Wahrscheinlichkeit ausgegeben.
Und hier noch der Code in RStudio
library(shiny)
library(ggplot2)
library(dplyr)
library(reshape2)
# UI for the application
ui <- fluidPage(
titlePanel("Simulation"), # Application title
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(id = "tPanel", style = "overflow-y:scroll; max-height: 600px; position:relative;",
h4("Product A"),
fluidRow(
div(style="display: inline-block; width: 5%;"),
div(style="display: inline-block; width: 45%;", h5("Plan Revenue")),
div(style="display: inline-block; width: 40%;", numericInput("plan_a", label=" ", value=20000, min = 0, max = NA))
),
fluidRow(
div(style="display: inline-block; width: 5%;"),
div(style="display: inline-block; width: 25%;", h5("Sales [u]")),
div(style="display: inline-block; width: 30%;", numericInput("mean_sales_a", label="mean", value=1000, min = 0, max = NA)),
div(style="display: inline-block; width: 30%;", numericInput("sd_sales_a", label="sd", value=200, min = 0, max = NA))
),
fluidRow(
div(style="display: inline-block; width: 5%;"),
div(style="display: inline-block; width: 25%;", h5("Price")),
div(style="display: inline-block; width: 30%;", numericInput("mean_price_a", label="mean", value=15, min = 0, max = NA)),
div(style="display: inline-block; width: 30%;", numericInput("sd_price_a", label="sd", value=3, min = 0, max = NA))
),
br(),
h4("Product B"),
fluidRow(
div(style="display: inline-block; width: 5%;"),
div(style="display: inline-block; width: 45%;", h5("Plan Revenue")),
div(style="display: inline-block; width: 40%;", numericInput("plan_b", label=" ", value=18000, min = 0, max = NA))
),
fluidRow(
div(style="display: inline-block; width: 5%;"),
div(style="display: inline-block; width: 25%;", h5("Sales [u]")),
div(style="display: inline-block; width: 30%;", numericInput("mean_sales_b", label="mean", value=500, min = 0, max = NA)),
div(style="display: inline-block; width: 30%;", numericInput("sd_sales_b", label="sd", value=50, min = 0, max = NA))
),
fluidRow(
div(style="display: inline-block; width: 5%;"),
div(style="display: inline-block; width: 25%;", h5("Price")),
div(style="display: inline-block; width: 30%;", numericInput("mean_price_b", label="mean", value=40, min = 0, max = NA)),
div(style="display: inline-block; width: 30%;", numericInput("sd_price_b", label="sd", value=20, min = 0, max = NA))
),
br(),
sliderInput("n", "Number of simulations:", min = 5000, max = 20000, value = 10000),
h6("mean ± 1sd for 68%, mean ± 2sd for 95%"),
br(),
submitButton("Submit")
),
# Showing the plots
mainPanel(
tabsetPanel(
tabPanel("Total Revenue",
plotOutput("product_total"),
htmlOutput("result_total")
),
tabPanel("Products",
h5("Product A"),
plotOutput("product_a"),
htmlOutput("result_a"),
br(),
h4("Product B"),
plotOutput("product_b"),
htmlOutput("result_b"),
br(),
br()
)
)
)
)
)
# Define server logic
server <- function(input, output) {
calc <- reactive({
set.seed(283) # for reproducibility
results = NULL
sales_a = rnorm(input$n, mean = input$mean_sales_a, sd=input$sd_sales_a) #normal distribution
price_a = rnorm(input$n, mean = input$mean_price_a, sd=input$sd_price_a) #normal distribution
contribution_a = sales_a * price_a
sales_b = rnorm(input$n, mean = input$mean_sales_b, sd=input$sd_sales_b) #normal distribution
price_b = rnorm(input$n, mean = input$mean_price_b, sd=input$sd_price_b) #normal distribution
contribution_b = sales_b * price_b
contribution_total = contribution_a + contribution_b
results = rbind(results, data.frame(contribution_a, contribution_b, contribution_total)) %>%
mutate(index = row_number()) %>%
as.data.frame() %>%
melt(. , id.vars="index")
})
output$product_a <- renderPlot({
calc() %>%
filter(variable == "contribution_a") %>%
ggplot(aes(x=value)) +
geom_histogram(aes(y=..count.., fill=ifelse(value < input$plan_a,'out of scope','in scope')), binwidth = input$n/100) +
geom_vline(aes(xintercept=input$plan_a), color="#66CDAA", linetype="dashed", size=1) +
theme_classic() +
scale_fill_manual("",
breaks=c("in scope","out of scope"),
values=c("#66CDAA","#C0C0C0")) +
xlab("Revenue") +
ylab("number of simulations")
})
output$result_a <- renderText({
number <- calc() %>%
filter(variable == "contribution_a") %>%
as.data.frame() %>%
filter(value >= input$plan_a) %>%
nrow()
percentage <- round(number / input$n,4) * 100
paste("The plan is met in", "<b>", number, "</b>", "cases, giving a probability of", "<b>", percentage, "%", "</b>")
})
output$product_b <- renderPlot({
calc() %>%
filter(variable == "contribution_b") %>%
ggplot(aes(x=value)) +
geom_histogram(aes(y=..count.., fill=ifelse(value < input$plan_b,'out of scope','in scope')), binwidth = input$n/100) +
geom_vline(aes(xintercept=input$plan_b), color="#66CDAA", linetype="dashed", size=1) +
theme_classic() +
scale_fill_manual("",
breaks=c("in scope","out of scope"),
values=c("#66CDAA","#C0C0C0")) +
xlab("Revenue") +
ylab("number of simulations")
})
output$result_b <- renderText({
number <- calc() %>%
filter(variable == "contribution_b") %>%
as.data.frame() %>%
filter(value >= input$plan_b) %>%
nrow()
percentage <- round(number / input$n,4) * 100
paste("The plan is met in", "<b>", number, "</b>", "cases, giving a probability of", "<b>", percentage, "%", "</b>")
})
output$product_total <- renderPlot({
calc() %>%
filter(variable == "contribution_total") %>%
ggplot(aes(x=value)) +
geom_histogram(aes(y=..count.., fill=ifelse(value < input$plan_a + input$plan_b,'out of scope','in scope')), binwidth = input$n/100) +
geom_vline(aes(xintercept=input$plan_a + input$plan_b), color="#66CDAA", linetype="dashed", size=1) +
theme_classic() +
scale_fill_manual("",
breaks=c("in scope","out of scope"),
values=c("#66CDAA","#C0C0C0")) +
xlab("Revenue") +
ylab("number of simulations")
})
output$result_total <- renderText({
number <- calc() %>%
filter(variable == "contribution_total") %>%
as.data.frame() %>%
filter(value >= input$plan_a + input$plan_b) %>%
nrow()
percentage <- round(number / input$n,4) * 100
paste("The plan is met in", "<b>", number, "</b>", "cases, giving a probability of", "<b>", percentage, "%", "</b>")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Foto von Ankush Rathi von Pexels