我正在尝试构建一个可以预测酒店取消的Shiny应用程序。但当我点击动作按钮时，用户不会得到预测。你能帮我解决这个问题吗？我是Shiny应用程序和R.编码的新手
数据集可以在以下链接中找到：https://1drv.ms/u/s！AnJKSfuVbEqDgQKHaSPuNHhVfkNk？e=pNNulI
hotel <- read.csv("/Users/sabrinagreifzu/Documents/Masterstudium Data Science/Anwedungsentwicklung/Stackoverflow/Hotel_Prediction_SG_1.csv", head = TRUE, sep=",")
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)
#Cross Validation
install.packages("rsample")
library(rsample)
data <- initial_split(hotel, .75, is_canceled)
train <- training(data)
test <- testing(data)
#X-y Splitting
train_x <- select(train, -is_canceled)
test_x <- select(test, -is_canceled)
train_y <- train$is_canceled
test_y <- test$is_canceled
#Machine Learning Modelling
set.seed(42)
model_rf <- randomForest(train_x, train_y, ntree = 100)
confusionMatrix(predict(model_rf, test_x), test_y)
#Saving the model
saveRDS(model_rf, file = "./model_rf.rda")
ui <- dashboardPage(dashboardHeader(title = "Hotel Prediction",
titleWidth = 290),
dashboardSidebar(width = 290,
sidebarMenu(menuItem("Prediction", tabName = 'pred'))),
dashboardBody(
tabItems(
tabItem('pred',
#Filters for categorical variables
box(title = 'Categorical variables',
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('deposit_type', 'Bezahltyp', c("No Deposit", "Non Refund","Refundable")),
div(),
selectInput('customer_type','Kundentyp', c('Transient','Contract','Group','Transient-Party')))),
#Box to display the prediction results
box(title = 'Prediction result',
status = 'success',
solidHeader = TRUE,
width = 12, height = 260,
div(h5('Total number of cancellations:')),
textOutput('predicted_value'),
actionButton('cal', 'Calculate', icon = icon('calculator'))),
)
)
))
server <- shinyServer(function(input, output){
observeEvent(input$cal,{
data <- data.frame(
Bezahltyp = input$deposit_type,
Kundentyp = input$customer_type)
output$predicted_value <- renderText({
predict(model_rf,data())
})
})
})
shinyApp(ui, server)```
对我来说，没有得到预测似乎有几个原因：
1.预测数据不准确
我们看到该模型是在13个变量上训练的
> train_x %>% names()
[1] "hotel" "adults"
[3] "children" "babies"
[5] "meal" "is_repeated_guest"
[7] "previous_cancellations" "previous_bookings_not_canceled"
[9] "reserved_room_type" "deposit_type"
[11] "customer_type" "adr"
[13] "total_of_special_requests"
但当你尝试predict(model_rf, data())时，你的数据集只包含两个变量：
data.frame(
Bezahltyp = input$deposit_type,
Kundentyp = input$customer_type
)
并且这些变量甚至没有与训练数据中的名称相同的名称。模型将如何知道哪些变量和值用于预测？
即使在Shiny之外运行，也会出现类似variables in the training data missing in newdata的错误。
通过向预测函数提供一个包含模型训练的所有变量的数据帧来解决这个问题。
2.闪光错误
在您当前的示例中，您执行predict(model_rf, data())，但data不是反应值，因此R认为您指的是函数utils::data()。这导致了错误number of variables in newdata does not match that in the training data。
我相信，在您的第一个示例中，数据被封装在reactive({})中，但最后的})放错了地方。在调用predict()函数之前，需要关闭它。
以下是一个适用于此应用程序的良好服务器端结构示例：
server <- shinyServer(function(input, output){
data <- reactive({
# Create your dataset here
# It needs to have the same variables as train_x
})
output$predicted_value <- renderText({
predict(model_rf, data())
}) %>%
# bindEvent is recommended over eventReactive
bindEvent(input$cal)
})
工作示例
在下面，我创建了一个较小的应用程序工作示例(顺便说一句，对于你的下一个问题，你想从一开始就提供这个(。我已经删除了我认为不必要的内容。我已经更改了服务器的结构，以便它实际返回预测。我认为你应该能够在你的项目中重用这个结构。
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)
# I'm assuming you are using the randomForest package
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(
title = 'Prediction result',
width = 12,
height = 260,
textOutput('predicted_value'),
actionButton('cal', 'Calculate', icon = icon('calculator'))
)
)
)
)
)
server <- shinyServer(function(input, output){
data <- reactive({
# Create your dataset here
train_x
})
output$predicted_value <- renderText({
predict(model_rf, data())
}) %>%
# bindEvent is recommended over eventReactive
bindEvent(input$cal)
})
shinyApp(ui, server)
这是当前代码：
list(
hotel = c(
"Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "City 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", "City 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", "City Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "City 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, 2, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 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", "SC", "BB", "BB", "BB", "BB", "BB",
"BB", "HB", "BB", "BB", "BB", "BB", "BB", "SC", "BB", "BB", "BB",
"BB", "BB", "BB", "BB", "BB", "HB", "BB", "BB", "BB", "Undefined", "Undefined",
"BB", "FB", "BB", "FB", "HB"),
is_repeated_guest = c(
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, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1
),
previous_cancellations = c(
0, 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, 1, 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, 2, 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, 1, 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", "Refundable", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "Non Refund",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "Non Refund", "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",
"Refundable", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "Non Refund", "No Deposit", "Non Refund",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"Refundable", "No Deposit", "No Deposit"
),
customer_type = c(
"Transient",
"Group", "Transient", "Transient", "Transient", "Transient",
"Transient", "Group", "Transient", "Transient", "Transient",
"Transient", "Transient", "Transient", "Transient", "Transient",
"Contract", "Transient", "Transient", "Transient", "Transient",
"Transient", "Transient", "Transient-Party", "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)
str(train_x)
hotel <- select(hotel, -is_canceled)
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),
div(),
sliderInput('previous_bookings_not_canceled', 'Buchungen_nicht_storniert', min = 0, max = 3, 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,
previous_bookings_not_cancelled = input$previous_bookings_not_canceled,
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
})
output$predicted_value <- renderText({
predict(model_rf, data(), type = "prob")
}) %>%
bindEvent(input$cal)
})
shinyApp(ui, server)```
list(
hotel = c(
"Resort Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "City 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", "City 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", "City Hotel", "Resort Hotel", "Resort Hotel",
"Resort Hotel", "Resort Hotel", "City 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, 2, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 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", "SC", "BB", "BB", "BB", "BB", "BB",
"BB", "HB", "BB", "BB", "BB", "BB", "BB", "SC", "BB", "BB", "BB",
"BB", "BB", "BB", "BB", "BB", "HB", "BB", "BB", "BB", "Undefined", "Undefined",
"BB", "FB", "BB", "FB", "HB"),
is_repeated_guest = c(
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, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 1
),
previous_cancellations = c(
0, 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, 1, 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, 2, 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, 1, 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", "Refundable", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "Non Refund",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "Non Refund", "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",
"Refundable", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"No Deposit", "No Deposit", "Non Refund", "No Deposit", "Non Refund",
"No Deposit", "No Deposit", "No Deposit", "No Deposit", "No Deposit",
"Refundable", "No Deposit", "No Deposit"
),
customer_type = c(
"Transient",
"Group", "Transient", "Transient", "Transient", "Transient",
"Transient", "Group", "Transient", "Transient", "Transient",
"Transient", "Transient", "Transient", "Transient", "Transient",
"Contract", "Transient", "Transient", "Transient", "Transient",
"Transient", "Transient", "Transient-Party", "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)
str(train_x)
hotel <- select(hotel, -is_canceled)
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),
div(),
sliderInput('previous_bookings_not_canceled', 'Buchungen_nicht_storniert', min = 0, max = 3, 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,
previous_bookings_not_cancelled = input$previous_bookings_not_canceled,
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
})
output$predicted_value <- renderText({
predict(model_rf, data(), type = "prob")
}) %>%
bindEvent(input$cal)
})
shinyApp(ui, server)```