如何使用Shiny将预测模型的输出附加到数据表中？

Question

我正在尝试使用以下方法将新列追加到表中：output$Prediction <- renderTable({rbind(rawData,prediction)})。我收到此错误：cannot coerce type 'closure' to vector of type 'list'。有没有更简单的解决方案来创建包含输出的新列？完整代码如下。

age=round(runif(100,15,100))
bmi=round(runif(100,15,45))
cholesterol=round(runif(100,100,200))
gender=sample(c('male','female'), 100, replace=TRUE, prob=c(0.45,0.55))
height=round(runif(100,140,200))
weight=round(runif(100,140,200))
outcome=sample(c('accepted','reject'),100,replace=T,prob=c(0.30,0.70))    
df=data.frame(age,bmi,cholesterol,gender,height,weight,outcome)
model <- glm(outcome ~.,family=binomial(link='logit'),data=df)



ui <- fluidPage(

  # App title ----
  titlePanel("Tabsets"),

  mainPanel(

    # Output: Tabset w/ plot, summary, and table ----
    tabsetPanel(type = "tabs",
                tabPanel("Single Prediction",
                         textOutput("Pred"),
                         numericInput(inputId='age', label='Age', value = 18,min = NA, max = NA, step = NA,width = NULL),
                         checkboxGroupInput(inputId='gender', label='Gender', c('male','female'), selected = 'female', inline = FALSE,width = NULL),
                         numericInput(inputId='bmi', label='bmi', value = 18,min = NA, max = NA, step = NA,width = NULL),
                         numericInput(inputId='height', label='Height', value = 150,min = NA, max = NA, step = NA,width = NULL),
                         numericInput(inputId='weight', label='Weight', value = 25, min = NA, max = NA, step = NA,width = NULL),
                         numericInput(inputId='cholesterol', label='Cholesterol', value = 25, min = NA, max = NA, step = NA,width = NULL)
                         ),
                tabPanel("Predict from csv", 
                         fileInput("csvFile", "Upload csv"),
                         textOutput("Prediction"),
                         tableOutput("rawData"))


    )

  )

)







server <- function(input, output, session) {
  rawData <- eventReactive(input$csvFile, {
    read.csv(input$csvFile$datapath)
  })

  output$rawData <- renderTable({
    rawData()
  })

  prediction <- reactive({
    predict(model,rawData(),type="response")
  })

  output$Prediction <- renderTable({rbind(rawData,prediction)})
  #output$Prediction <- renderText(prediction())

  data <- reactive({
    req(input$gender)
    data.frame(age=input$age,
               gender=input$gender,
               bmi=input$bmi,
               height=input$height,
               weight=input$weight,
               cholesterol=input$cholesterol)
  })

  pred <- reactive({
    predict(model,data(),type="response")
  })

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

shinyApp(ui, server)

Answer 1

该代码有我解决的几个问题：

• 将textOutput更改为tableOutput，但是我仍然保留第二个tableOutput没有预测（低于具有预测的预测），因为我不确定是否要保留它
• 将rawData中的prediction和renderTable更改为函数而不是变量，因为电抗值应像函数一样被调用
• 将rbind更改为cbind，以便有一个带有预测的新列
• [示例数据也存在问题，因为glm函数需要数字变量作为要预测的值，所以我在glm函数中将“ accepted”转换为1并将“ reject”转换为0]]

我还通过输入一个文件对它进行了测试，该文件是df的csv

这里是代码：

library(shiny)
age=round(runif(100,15,100))
bmi=round(runif(100,15,45))
cholesterol=round(runif(100,100,200))
gender=sample(c('male','female'), 100, replace=TRUE, prob=c(0.45,0.55))
height=round(runif(100,140,200))
weight=round(runif(100,140,200))
outcome=sample(c('accepted','reject'),100,replace=T,prob=c(0.30,0.70))    
df=data.frame(age,bmi,cholesterol,gender,height,weight,outcome)
model <- glm(2 / as.numeric(as.factor(outcome))  - 1 ~.,family=binomial(link='logit'),data=df)



ui <- fluidPage(

  # App title ----
  titlePanel("Tabsets"),

  mainPanel(

    # Output: Tabset w/ plot, summary, and table ----
    tabsetPanel(type = "tabs",
                tabPanel("Single Prediction",
                         textOutput("Pred"),
                         numericInput(inputId='age', label='Age', value = 18,min = NA, max = NA, step = NA,width = NULL),
                         checkboxGroupInput(inputId='gender', label='Gender', c('male','female'), selected = 'female', inline = FALSE,width = NULL),
                         numericInput(inputId='bmi', label='bmi', value = 18,min = NA, max = NA, step = NA,width = NULL),
                         numericInput(inputId='height', label='Height', value = 150,min = NA, max = NA, step = NA,width = NULL),
                         numericInput(inputId='weight', label='Weight', value = 25, min = NA, max = NA, step = NA,width = NULL),
                         numericInput(inputId='cholesterol', label='Cholesterol', value = 25, min = NA, max = NA, step = NA,width = NULL)
                ),
                tabPanel("Predict from csv", 
                         fileInput("csvFile", "Upload csv"),
                         tableOutput("Prediction"),
                         tableOutput("rawData"))


    )

  )

)







server <- function(input, output, session) {
  rawData <- eventReactive(input$csvFile, {
    read.csv(input$csvFile$datapath)
  })

  output$rawData <- renderTable({
    rawData()
  })

  prediction <- reactive({
    predict(model,rawData(),type="response")
  })

  output$Prediction <- renderTable({cbind(rawData(), prediction())})
  #output$Prediction <- renderText(prediction())

  data <- reactive({
    req(input$gender)
    data.frame(age=input$age,
               gender=input$gender,
               bmi=input$bmi,
               height=input$height,
               weight=input$weight,
               cholesterol=input$cholesterol)
  })

  pred <- reactive({
    predict(model,data(),type="response")
  })

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

shinyApp(ui, server)