jbelmonte
jbelmonte

Reputation: 25

Prediction values not reacting to user inputs Rshiny

I am trying to build a shiny app that gives new predictions based on various user inputs. However, even though the input values are updating with the inputs, the prediction value does not update. Im am having trouble figuring out why.

The model is a random forest regression model, in the example I am using numeric variables but in my situation the inputs are categorical (I dont think this change should effect anything) This is why the sidebar is all select input as opposed to select numeric

I made a reproducible example with the mtcars dataset

model <- ranger(mpg ~ disp + hp + wt, data = mtcars)



ui <- fluidPage(
  sidebarPanel(
    selectInput('disp', 'disp',
              choices = unique(mtcars$disp),
            selected = unique(mtcars$disp)[1]),
selectInput('hp', 'hp',
            choices = unique(mtcars$hp),
            selected = unique(mtcars$hp)[1]),
selectInput('wt', 'wt',
            choices = unique(mtcars$wt)),
actionButton("Enter", "Enter Values"),
width = 2
  ),
  mainPanel(
tableOutput('mpg')
)
)

server <- function(input, output, session) {




  val <- reactive({

new <- mtcars[1, ]
new$disp <- input$disp
new$hp <- input$hp
new$wt <- input$wt

new
  })

  out <- eventReactive(
    input$Enter,
    {
      val <- val()
      val$pred <- predict(model, data = val)$predictions
      val

    })

  output$mpg <- renderTable({


    out()

  })


}

shinyApp(ui, server)

Upvotes: 2

Views: 535

Answers (1)

Nick Holt
Nick Holt

Reputation: 116

There are several issues here.

1) You are using selectInput incorrectly. See below. Basically, using indexes like mtcars$disp[1] will create static values, no matter what is selected.

2) You are using renderTable() when you are only producing a single value as output. Why not just use renderText()? See below.

3) The eventReactive trigger (i.e., input$enter) needs to be used to create the data frame of input values. The model prediction can run on the data frame later, but the initial trigger actually pulls the values from selectInput, so the trigger needs to be in the same block where the data frame is created.

This ran correctly and produced the desired output on my machine:

library(shiny)
library(ranger)

model <- ranger(mpg ~ disp + hp + wt, data = mtcars)

ui <- fluidPage(

        sidebarPanel(

                selectInput('disp', 'disp',
                            unique(mtcars$disp)),

                selectInput('hp', 'hp',
                            unique(mtcars$hp)),

                selectInput('wt', 'wt',
                            unique(mtcars$wt)),

                actionButton("enter", label = "Enter Values"),
                width = 2
        ),

        mainPanel(

                textOutput('mpg')

        )

)

server <- function(input, output, session) {

        val <- eventReactive(

                input$enter, {

                data.frame(

                        disp = input$disp,
                        hp = input$hp,
                        wt = input$wt,
                        stringsAsFactors = F

                )}

        )

        output$mpg <- renderText({

                predict(model, val())[[1]]

        })

}

shinyApp(ui, server)

Upvotes: 2

Related Questions