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

Question

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

为了更好的重现性，我使用了波士顿住房数据。

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

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 必须是一个因素。

Answer 2

这是您的代码的工作版本。

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)