Hi, thanks for your quick answer. Here is the example and this is what the shiny app should do:
For example, if the user enters babies = 1, adr (cost) = 75, total_of_special_requests = 2, then the shiny app should give out as a percentage number (one single number) how likely it is that a cancellation will occur under the criteria selected above.
Could you please help me with that?
hotel <- structure(
list(
hotel = c(
"Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "Resort Hotel"),
is_canceled = c(0,
0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 1, 0, 0,
0, 0, 1, 0, 0, 0, 0),
adults = c(2, 2, 1, 1, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1,
2, 2, 2, 3, 3, 2, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2),
children = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 2, 0, 0, 0, 0),
babies = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
meal = c("BB",
"BB", "BB", "BB", "BB", "BB", "BB", "FB", "BB", "HB", "BB", "HB",
"BB", "HB", "BB", "BB", "BB", "BB", "BB", "BB", "BB", "BB", "BB",
"BB", "HB", "BB", "BB", "BB", "BB", "BB", "BB", "BB", "BB", "BB",
"BB", "BB", "BB", "BB", "BB", "HB", "BB", "BB", "BB", "HB", "BB",
"BB", "BB", "BB", "HB", "HB"),
is_repeated_guest = c(
0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0
),
previous_cancellations = c(
0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0
),
previous_bookings_not_canceled = c(
0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0
),
reserved_room_type = c(
"C", "C", "A", "A", "A", "A", "C",
"C", "A", "D", "E", "D", "D", "G", "E", "D", "E", "A", "A", "G",
"F", "A", "A", "D", "D", "D", "D", "E", "A", "D", "A", "D", "E",
"A", "D", "D", "A", "D", "D", "E", "G", "D", "F", "E", "A", "G",
"A", "E", "A", "E"
),
deposit_type = c(
"No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit"
),
customer_type = c(
"Transient",
"Transient", "Transient", "Transient", "Transient", "Transient",
"Transient", "Transient", "Transient", "Transient", "Transient",
"Transient", "Transient", "Transient", "Transient", "Transient",
"Contract", "Transient", "Transient", "Transient", "Transient",
"Transient", "Transient", "Transient", "Contract", "Transient",
"Contract", "Transient", "Transient", "Transient", "Transient",
"Transient", "Transient", "Transient", "Transient", "Transient",
"Transient", "Transient", "Transient", "Transient", "Transient",
"Contract", "Transient", "Transient", "Transient", "Transient",
"Transient", "Transient-Party", "Contract", "Transient"
),
adr = c(
0,
0, 75, 75, 98, 98, 107, 103, 82, 105, 123, 145, 97, 154, 94,
97, 97, 88, 107, 153, 97, 84, 84, 99, 94, 63, 79, 107, 94, 87,
62, 63, 108, 65, 108, 108, 98, 108, 108, 137, 117, 79, 123, 137,
110, 153, 58, 82, 82, 119
),
total_of_special_requests = c(
0,
0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 3, 1, 0, 3, 0, 0, 0, 1, 1, 1,
1, 1, 1, 0, 0, 2, 0, 1, 2, 0, 2, 0, 1, 1, 0, 1, 0, 1, 0, 0, 0,
1, 2, 0, 1, 2, 0, 1
)
),
row.names = c(NA, -50L),
class = c("tbl_df",
"tbl", "data.frame")
)
hotel$is_canceled <- as.factor(hotel$is_canceled)
hotel$is_repeated_guest <- as.factor(hotel$is_repeated_guest)
hotel$meal <- as.factor(hotel$meal)
hotel$reserved_room_type <- as.factor(hotel$reserved_room_type)
hotel$deposit_type <- as.factor(hotel$deposit_type)
hotel$customer_type <- as.factor(hotel$customer_type)
hotel$adr <- as.integer(hotel$adr)
hotel$hotel <- as.factor(hotel$hotel)
library(dplyr)
train_x <- select(hotel, -is_canceled)
train_y <- hotel$is_canceled
set.seed(42)
model_rf <- randomForest::randomForest(train_x, train_y, ntree = 100)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "Hotel Prediction",
titleWidth = 290
),
dashboardSidebar(
width = 290,
sidebarMenu(menuItem("Prediction", tabName = 'pred'))),
dashboardBody(
tabItems(
tabItem(
'pred',
# Box to display the prediction results
box(
status = 'primary', width = 12,
splitLayout(
tags$head(tags$style(HTML(".shiny-split-layout > div {overflow: visible;}"))),
cellWidths = c('0%', '19%', '4%', '19%', '4%', '19%', '4%', '19%', '4%', '8%'),
selectInput('hotel', 'hotel', c('City Hotel','Resort Hotel')),
div(),
sliderInput('adults', 'Erwachsene', min = 0, max = 26, value = 0),
div(),
sliderInput('children', 'Kinder', min = 0, max = 3, value = 0))),
#Filters for numeric variables
box(
status = 'primary', width = 12,
splitLayout(
cellWidths = c('22%', '4%','21%', '4%', '21%', '4%', '21%'),
sliderInput('babies', 'Babys', min = 0, max = 10, value = 0),
div(),
selectInput('meal', 'Mahlzeit', c('BB','HB','SC','Undefined','FB')),
div(),
selectInput('is_repeated_guest', 'Wiederholter Gast', c('1','0')),
div(),
sliderInput('previous_cancellations', 'Stornierungen', min = 0, max = 26, value = 0))),
box(
status = 'primary', width = 12,
splitLayout(
cellWidths = c('22%', '4%','21%', '4%', '21%', '4%', '21%'),
selectInput('reserved_room_type', 'Raumtyp', c('A','D','E','F','G')),
div(),
selectInput('deposit_type', 'Deposit-Typ', c('No deposit','Non Refund','Refundable')),
div(),
selectInput('customer_type', 'Kundentyp', c('Transient','Transient-Party','Contract','Group')),
div(),
sliderInput('adr','Kosten', min = 0, max = 1000, value = 0))),
box(title = 'Numerical variables',
status = 'primary', width = 12,
splitLayout(
cellWidths = c('22%', '4%','21%', '4%', '21%', '4%', '21%'),
sliderInput('total_of_special_requests', 'Sonderwuensche', min = 0, max = 5, value = 0)),
box(
title = 'Prediction result',
width = 12,
height = 260,
textOutput('predicted_value'),
actionButton('cal', 'Calculate', icon = icon('calculator'))
)
)
)
)
))
server <- shinyServer(function(input, output){
data <- reactive({
data.frame(
hotel = input$hotel,
adults = input$adults,
children = input$children,
babies = input$babies,
meal = input$meal,
is_repeated_guest = input$is_repeated_guest,
previous_cancellations = input$previous_cancellations,
reserved_room_type = input$reserved_room_type,
deposit_type = input$deposit_type,
customer_type = input$customer_type,
adr = input$adr,
total_of_special_requests = input$total_of_special_requests)
# Create your dataset here
train_x
})
output$predicted_value <- renderText({
predict(model_rf, data(), type = "prob")
}) %>%
# bindEvent is recommended over eventReactive
bindEvent(input$cal)
})
shinyApp(ui, server)