Unable to get a prediction result in shiny app-CodePudding

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

CodePudding user response：

To me, there seems to be several reasons why you don't get a prediction:

1. Misspecification of the predict data

We see that the model is trained on 13 variables

> 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"

But when you try to predict(model_rf, data()) your dataset is only containing two variables:

data.frame(
    Bezahltyp = input$deposit_type,
    Kundentyp = input$customer_type
)

and the variables don't even have the same names as in the training data. How will the model know which variables and values to use for the prediction?

This would give you an error like variables in the training data missing in newdata even when run outside of Shiny.

Fix this by supplying a dataframe with all variables the model was trained on to the predict function.

2. Shiny error

In your current example, you do predict(model_rf, data()) but data is not a reactive value, so R thinks you mean the function utils::data(). This leads to the error number of variables in newdata does not match that in the training data.

I believe that in your first example, data was wrapped in reactive({}) but that the closing }) was misplaced. It needs to be closed before calling the predict() function.

Here is an example of a good server side structure for this application:

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

Working example

Under I have created a smaller working example of your app (btw, for your next question, you want to provide this from the start). I have removed anything I deemed unnecessary for this illustration. I have changed the structure of the server, so that it actually returns predictions. I think you should be able to reuse this structure for your project.

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)

CodePudding user response：

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)

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 = '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('hotel', 'hotel', c('City Hotel','Resort Hotel')),
              div(),
              selectInput('is_canceled','Stornierungen', c('0','1')),
              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(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('meal', 'Mahlzeit', c('BB','HB','SC','Undefined','FB')),
              div(),
              sliderInput('is_repeated_guest', 'Wiederholter Gast',  c('1','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('reserved_room_type', 'Raumtyp',  c('A','D','E','F','G')),
              div(),
              sliderInput('deposit_type', 'Deposit-Typ', c('No deposit','Non Refund','Refundable')),
              div(),
              sliderInput('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({
    req(input$hotel)
    req(input$is_canceled)
    req(input$adults)
    req(input$children)
    req(input$babies)
    req(input$is_repeated_guest)
    req(input$previous_cancellations)
    req(input$adr)
    req(input$ttotal_of_special_requests)
    data.frame(
      hotel = input$hotel,
      is_canceled = input$is_canceled,
      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())
    
  }) %>% 
    # bindEvent is recommended over eventReactive
    bindEvent(input$cal)
  
})

shinyApp(ui, server)```