Как добавить вывод модели прогнозирования в Dataatable с помощью Shiny? - PullRequest
Новая
       117

Как добавить вывод модели прогнозирования в Dataatable с помощью Shiny?

0 голосов
/ 03 мая 2020

Я пытаюсь добавить новый столбец в таблицу, используя следующее: 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)

1 Ответ

0 голосов
/ 03 мая 2020

В коде было несколько проблем, которые я исправил:

  • Изменил textOutput на tableOutput, но я все еще оставил вторую tableOutput без прогнозов (что ниже, чем у предсказания), поскольку я не был уверен, хотите ли вы сохранить его
  • Изменили rawData и prediction внутри renderTable на функции вместо переменных, так как реактивные значения должны вызываться как функции
  • Изменил rbind на cbind, чтобы появился новый столбец с предсказаниями
  • Также возникла проблема с данными примера, так как функция glm требует цифры c переменная как значение, которое должно быть предсказано, поэтому я преобразовал «принято» в 1 и «отклонить» в 0 внутри функции glm

Я также проверил это, введя файл, который был CSV из df

Вот код: 

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)
...