不反应以用户输入的预测值R闪亮

Question

我想建立一个闪亮的应用程式，让基于各种用户输入新的预测。但是，即使输入的值与输入更新时，预测值不更新。林我有麻烦弄清楚为什么。

该模型是一个随机森林回归模型，在这个例子中我使用的数值变量，但在我的情况的输入是明确的（我不认为这种变化应该影响任何东西）这就是为什么侧边栏，而不是选择所有的数字输入选择

我做了一个重复的例子，与mtcars数据集

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)

Answer 1

这里有几个问题。

1）你是不正确的使用selectInput。见下文。基本上，使用索引像mtcars $ DISP [1]将创建静态值，无论选择什么。

2）正在使用renderTable（）时，只产生一个单一的值作为输出。为什么不直接使用renderText（）？见下文。

3）eventReactive触发（即，输入$输入）需要被用于创建输入值的数据帧。该模型预测可以将数据帧上以后运行，但初始触发实际从selectInput拉动值，所以触发器需要在其中创建的数据帧相同的块。

这种正确运行，并制作我的机器上所需的输出：

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)