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

Question

我正在尝试使用以下方法将新列附加到 table 中： 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（低于有预测的那个），因为我不确定您是否想保留它
将 renderTable 中的 rawData 和 prediction 更改为函数而不是变量，因为反应值应该像函数一样被调用
将 rbind 更改为 cbind，这样就会有一个包含预测的新列
示例数据也有问题，因为 glm 函数需要一个数值变量作为要预测的值，所以我将 "accepted" 转换为 1，将 "reject" 转换为0 在 glm 函数中

我也通过输入一个文件来测试它，它是 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)

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

How to append output of prediction model into datatable using Shiny?

r

predict

shiny