无法获得用于预测模型的闪亮输出

Question

我是Shiny App的新手，并寻求经验丰富的用户的帮助。问题：我想创建一个用户输入闪亮的应用程序，其中用户将输入值，他/她将在应用程序中获得所需的输出。例如放置所有13个变量，并获得与之对应的房屋的中位数。我尝试使用以下代码，但未生成输出。

为了获得更好的再现性，我使用了Boston Housing数据。

library(rpart)

set.seed(1234)
train_index <- sample(nrow(Boston),0.75*nrow(Boston))
boston_train <- Boston[train_index,]   
boston_test <- Boston[-train_index,]

boston.rpart <- rpart(formula = medv ~ ., data = boston_train)

train_pred <- predict(object = boston.rpart)
test_pred <- predict(boston.rpart, boston_test)

library(shiny)
ui = fluidPage(

  titlePanel(" Boston Housing Model"),
  sidebarLayout(position = "left",
                sidebarPanel(

                  sliderInput("selectCrim", "crim:",min = 0., max = 100,value =10 , step = 1),
                  sliderInput("selectZn", "zn:",min = 0., max = 100,value = 10, step = 1),
                  sliderInput("selectIndus", "indus:",min = 0., max = 100,value = 11, step = 1),
                  sliderInput("selectChas", "chas:",min = 0., max = 1,value = 0, step = 1),
                  sliderInput("selectNox", "nox:",min = 0., max = 1,value = 0.5, step = 0.1),
                  sliderInput("selectRm", "rm:",min = 0, max = 10,value = 5, step = 1),
                  sliderInput("selectAge", "age:",min = 0, max = 100,value = 50, step = 1),
                  sliderInput("selectDis", "dis:",min = 0, max = 20,value = 5, step = 1),
                  sliderInput("selectRad", "rad:",min = 1, max = 24,value = 12, step = 1),
                  sliderInput("selectTax", "tax:",min = 100, max = 1000, value = 500, step = 100),
                  sliderInput("selectPtratio", "ptratio:",min = 10, max = 30,value = 20, step = 1),
                  sliderInput("selectBlack", "black:",min = 0., max = 400,value = 250, step = 50),
                  sliderInput("selectLstat", "lstat:",min = 0, max = 100,value = 40, step = 1),
                  submitButton('Submit')

                ),
                mainPanel("Pred")
  )
)

server = function (input,output) {
  data <- reactive({
        data.frame(crim=input$selectCrim,
           zn=input$selectZn,
           indus=input$selectIndus,
           chas=input$selectChas,
           nox=input$selectNox,
           rm=input$selectRm,
           age=input$selectAge,
           dis=input$selectDis,
           rad=input$selectRad,
           tax=input$selectTax,
           ptratio=input$selectPtratio,
           black=input$selectBlack,
           lstat=input$selectLstat
               )
  })

  pred <- reactive({
    predict(boston.rpart,data())
  })

  output$Pred <- renderText(pred())
}

shinyApp(ui=ui,server=server)

Answer 1

这是您的代码的有效版本。

ui <- fluidPage(
  titlePanel(" Boston Housing Model"),
  sidebarLayout(
    position = "left",
    sidebarPanel(
      sliderInput("selectCrim", "crim:",min = 0., max = 100,value =10 , step = 1),
      sliderInput("selectZn", "zn:",min = 0., max = 100,value = 10, step = 1),
      sliderInput("selectIndus", "indus:",min = 0., max = 100,value = 11, step = 1),
      sliderInput("selectChas", "chas:",min = 0., max = 1,value = 0, step = 1),
      sliderInput("selectNox", "nox:",min = 0., max = 1,value = 0.5, step = 0.1),
      sliderInput("selectRm", "rm:",min = 0, max = 10,value = 5, step = 1),
      sliderInput("selectAge", "age:",min = 0, max = 100,value = 50, step = 1),
      sliderInput("selectDis", "dis:",min = 0, max = 20,value = 5, step = 1),
      sliderInput("selectRad", "rad:",min = 1, max = 24,value = 12, step = 1),
      sliderInput("selectTax", "tax:",min = 100, max = 1000, value = 500, step = 100),
      sliderInput("selectPtratio", "ptratio:",min = 10, max = 30,value = 20, step = 1),
      sliderInput("selectBlack", "black:",min = 0., max = 400,value = 250, step = 50),
      sliderInput("selectLstat", "lstat:",min = 0, max = 100,value = 40, step = 1)
    ),
    mainPanel(textOutput("Pred"))
  )
)    
server <- function(input,output) {
  output$Pred <- renderText({
    data <- data.frame(crim=input$selectCrim,
      zn=input$selectZn, indus=input$selectIndus,
      chas=input$selectChas, nox=input$selectNox,
      rm=input$selectRm, age=input$selectAge,
      dis=input$selectDis, rad=input$selectRad,
      tax=input$selectTax, ptratio=input$selectPtratio,
      black=input$selectBlack, lstat=input$selectLstat)
    predict(boston.rpart, data)
  })
}
shinyApp(ui=ui, server=server)

Answer 2

以某种方式，submitButton在将输入存储在data.frame中时表现得很奇怪。我不太确定这是怎么回事，但是解决方案是改用actionButton和observeEvent。

代码中的另一个问题是您没有正确指定textOutput。另外，我还将这些括号{}用于渲染功能，因为显然如果您有时R的表现很怪异。

library(rpart)

set.seed(1234)
library(mlbench)
data(BostonHousing)
Boston <- BostonHousing
train_index <- sample(nrow(Boston),0.75*nrow(Boston))
boston_train <- Boston[train_index,]   
boston_test <- Boston[-train_index,]

boston.rpart <- rpart(formula = medv ~ ., data = boston_train)

train_pred <- predict(object = boston.rpart)
test_pred <- predict(boston.rpart, boston_test)

library(shiny)
ui = fluidPage(

  titlePanel(" Boston Housing Model"),
  sidebarLayout(position = "left",
                sidebarPanel(

                  sliderInput("selectCrim", "crim:",min = 0., max = 100,value =10 , step = 1),
                  sliderInput("selectZn", "zn:",min = 0., max = 100,value = 10, step = 1),
                  sliderInput("selectIndus", "indus:",min = 0., max = 100,value = 11, step = 1),
                  sliderInput("selectChas", "chas:",min = 0., max = 1,value = 0, step = 1),
                  sliderInput("selectNox", "nox:",min = 0., max = 1,value = 0.5, step = 0.1),
                  sliderInput("selectRm", "rm:",min = 0, max = 10,value = 5, step = 1),
                  sliderInput("selectAge", "age:",min = 0, max = 100,value = 50, step = 1),
                  sliderInput("selectDis", "dis:",min = 0, max = 20,value = 5, step = 1),
                  sliderInput("selectRad", "rad:",min = 1, max = 24,value = 12, step = 1),
                  sliderInput("selectTax", "tax:",min = 100, max = 1000, value = 500, step = 100),
                  sliderInput("selectPtratio", "ptratio:",min = 10, max = 30,value = 20, step = 1),
                  sliderInput("selectBlack", "black:",min = 0., max = 400,value = 250, step = 50),
                  sliderInput("selectLstat", "lstat:",min = 0, max = 100,value = 40, step = 1),
                  actionButton('submitButton', "Submit")

                ),
                mainPanel(textOutput("Pred"))
  )
)

server = function (input,output) {
  data <- reactive({
    data.frame(crim=input$selectCrim,
               zn=input$selectZn,
               indus=input$selectIndus,
               chas=as.factor(input$selectChas),
               nox=input$selectNox,
               rm=input$selectRm,
               age=input$selectAge,
               dis=input$selectDis,
               rad=input$selectRad,
               tax=input$selectTax,
               ptratio=input$selectPtratio,
               black=input$selectBlack,
               lstat=input$selectLstat
    )
  })

  pred <- reactive({
    predict(boston.rpart,data())
  })

  observeEvent(input$submitButton, {
    output$Pred <- renderText({pred()})

  })

}

shinyApp(ui=ui,server=server)

注意：当我使用mlbench包中的数据时，chas必须是一个因素。