I am trying to build a Shiny app that predicts hotel cancellations. But when I click on the action button the user does not get a prediction. Can you please help me to solve this problem? I am new to Shiny app and coding in R.
The dataset can be found at this link: Microsoft OneDrive - Access files anywhere. Create docs with free Office Online.
library(tidyr)
library(dplyr)
library(ggplot2)
library(caret)
library(e1071)
library(party)
library(randomForest)
library(shiny)
library(shinydashboard)
theme_ds <- theme(
panel.background = element_rect(fill="#6CADDF"),
panel.border = element_rect(fill=NA),
panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill="#00285E"),
text = element_text(color="white"),
axis.text = element_text(color="white")
)
hotel <- read.csv("/Users/sabrinagreifzu/Documents/Masterstudium Data Science/Anwedungsentwicklung/Data/hotel_bookings.csv", head = TRUE, sep=";")
#View(hotel)
str(hotel)
nrow(hotel)
hotel$is_canceled <- as.factor(hotel$is_canceled)
hotel$is_repeated_guest <- as.factor(hotel$is_repeated_guest)
str(hotel)
nrow(hotel)
colSums(is.na(hotel))
hotel <- na.omit(hotel)
anyNA(hotel)
hotel %>%
select(-reservation_status, -required_car_parking_spaces) -> hotel
#Visualizations
summary(hotel)
#p1 <- ggplot(hotel, aes(hotel)) + geom_bar() + theme_ds
#p2 <- ggplot(hotel, aes(meal)) + geom_bar() + theme_ds
#p3 <- ggplot(hotel, aes(deposit_type)) + geom_bar() + theme_ds
#p4 <- ggplot(hotel, aes(customer_type)) + geom_bar() + theme_ds
#ggpubr::ggarrange(p1, p2, p3, p4)
summary(select(hotel, adr, adults, children, babies))
nrow(hotel[hotel$adults>20,])
nrow(hotel)
str(hotel)
hotel <- hotel %>%
select(-lead_time,-arrival_date_year,-arrival_date_month,-arrival_date_week_number,-arrival_date_day_of_month,
-stays_in_week_nights,-stays_in_weekend_nights,-country,-market_segment,-distribution_channel,-assigned_room_type,
-booking_changes,-agent,-company,-days_in_waiting_list,-reservation_status_date)
str(hotel)
#View(hotel)
nrow(hotel[hotel$adults>20,])
str(hotel)
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)
length(which(rowSums(is.na(hotel))>0))
hotel <- hotel %>% drop_na()
length(which(rowSums(is.na(hotel))>0))
nrow(hotel[hotel$adults>20,])
#nrow(hotel[hotel$adr>1000,])
#hotel <- hotel[hotel$adr<1000,]
nrow(hotel[hotel$adr>1000,])
write.csv(hotel, "Hotel_Prediction_SG.csv", row.names = FALSE)
#Data Preparation
#Cross Validation
install.packages("rsample")
library(rsample)
data <- initial_split(hotel, .75, is_canceled)
nrow(data)
train <- training(data)
test <- testing(data)
nrow(train)
nrow(test)
#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
dim(train_x)
length(test_y)
#Machine Learning Modelling
set.seed(42)
model_rf <- randomForest(train_x, train_y, ntree = 100)
confusionMatrix(predict(model_rf, test_x), test_y)
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')))),
#Filters for numeric variables
box(title = 'Numerical variables',
status = 'primary', width = 12,
splitLayout(
cellWidths = c('22%', '4%','21%', '4%', '21%', '4%', '21%'),
sliderInput('adr', 'Kosten', min = 0, max = 510, value = 0),
div(),
sliderInput('total_member', 'Gaeste', min = 0, max = 55, value = 0),
div(),
sliderInput('total_of_special_requests', 'Sonderwuensche', min = 0, max = 5, value = 0),
div(),
sliderInput('previous_cancellations', 'Stornierungen', min = 0, max = 26, value = 0))),
box(title = 'Numerical variables',
status = 'primary', width = 12,
splitLayout(
cellWidths = c('22%', '4%','21%', '4%', '21%', '4%', '21%'),
sliderInput('babies', 'Babys', min = 0, max = 10, value = 0),
div(),
sliderInput('children', 'Kinder', min = 0, max = 3, value = 0),
div(),
sliderInput('adults', 'Erwachsene', min = 0, max = 26, value = 0))),
#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'),
#textOutput("Pred")),
actionButton('save_data', 'Calculate', icon = icon('calculator'))),
)
)
))
server <- shinyServer(function(input, output){
#a <- reactiveValues(result = NULL)
observeEvent(input$save_data,{
data <- reactive({
req(input$deposit_type)
req(input$customer_type)
req(input$adr)
req(input$total_member)
req(input$total_of_special_requests)
req(input$previous_cancellations)
req(input$babies)
req(input$children)
req(input$adults)
data.frame(
Bezahltyp = input$deposit_type,
Kundentyp = input$customer_type,
Kosten = input$adr,
Gaeste = input$total_member,
Sonderwuensche = input$total_of_special_requests,
Stornierungen = input$previous_cancellations,
Babys = input$babies,
Kinder = input$children,
Erwachsene = input$adults)
#print(data)
#print(model_final$predict(data))
output$predicted_value <- renderText({
predict(model_rf,data())
})
#test_pred <- rbind(test_pred, data)
#a$result <- predict(model_final,
# newdata = test_pred[nrow(test_pred),])
})
#output$value <- renderText({
#paste(a$result)
#})
})
})
shinyApp(ui, server)```