Unable to get a prediction result in shiny app

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)```

hi @Sabrina_Greifzu, do you get any error? Unfortunately the dataset you are linking to is not available, so I can't reproduce the issue.

If you can create a reproducible example of the problem, you are more likely to get help.

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)

Partly (in the example data anyway), some of the factors don't contain all the factors so the model can't predict. For example the only value for hotel$hotel is "Resort Hotel", but then "City Hotel" is an option. Not sure if that is the issue, but that is something that comes up when I try to test it.

Here are my tips/findings:

  • your data reactive returns now the train_x, you should remove that so it just returns the data.frame with user inputs.
  • after removing that and running the app, I am getting "Warning: Error in predict.randomForest: variables in the training data missing in newdata". E.g. "previous_bookings_not_canceled" is in your train_x but not in the data reactive. You need to make sure the data reactive and train_x contain the same variables and they need to be of same type.
    I would advice you to first make a plain R script that trains your model and makes a prediction. Once you get that working, make the move to a shiny app.
1 Like

Hi, thanks a lot for your tips and findings. I have implemented all your advice but unfortunately the following error still appears when I click on the action button: Error in predict.randomForest: variables in the training data missing in newdata. Could you look again where the error could be in the code and what I have to do to make it work?

Here the current code:

hotel <- structure(
  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)
        
  })
  
  output$predicted_value <- renderText({
    
    predict(model_rf, data(), type = "prob")
    
  }) %>% 
    bindEvent(input$cal)
  
})

shinyApp(ui, server)

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.