Прогнозирование от пользовательского ввода - Shiny - PullRequest
Новая
       6

Прогнозирование от пользовательского ввода - Shiny

0 голосов
/ 30 октября 2018

Я пытаюсь создать веб-интерфейс, в котором я хочу делать прогнозы из предварительно построенной модели на основе входных данных, предоставленных пользователем.

Ниже приведены фиктивные данные и модель 

# creation of dummy data and model

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)

Теперь я попробую создать блестящее приложение, ссылающееся на множество ссылок и похожих проблем, с которыми сталкиваются люди. Я новичок и до сих пор не смог решить проблему. Хотя при запуске приложения ошибки нет, выходные данные, т.е. вероятность, нигде не печатаются на веб-странице

Код интерфейса пользователя 

library(shiny)
ui = fluidPage(


# this is an input object   
titlePanel("Underwriting Prediction Model"),
sidebarLayout(position = "right",
              sidebarPanel(),
              mainPanel(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 = NULL, 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),

textOutput(outputId = 'Pred')

)

Сервер 

server = function (input,output) {
data<-reactive({
   df_final=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())})

output$Pred <- renderPrint(pred())

}

shinyApp(ui=ui,server=server)

Когда я предоставляю входные значения, я не получаю распечатки для моих прогнозов. Я вызываю переменную в render print, а главная панель еще не видна. В чем здесь проблема?

Ответы [ 2 ]

0 голосов
/ 30 октября 2018

Есть несколько проблем с вашим приложением. Как упоминалось @fenix_fx, у вас есть 2 textOutput(outputId = 'Pred'), которые сталкиваются. Поэтому он не будет отображать вывод, если он был создан.

Вход gender начинается со значения NULL, поэтому вам придется ждать в вашем реактиве, пока значение не будет выбрано, в противном случае будет выдано сообщение об ошибке, что data.frame не может быть создан из-за разных строк. Вы можете сделать это с req() или validate(need(...)). Я положил req(input$gender) в данные реагирующие.

Другая проблема заключалась в том, что вы строили модель glm с половыми метками мужчина и женщина , но ваш checkboxGroupInput предоставляет параметры мужчина и Женский . Это даст вам эту ошибку, и прогноз не может быть сделан.

фактор пол имеет новый уровень Мужской

И последняя проблема, я думаю, заключалась в том, что ваш ввод для weight имеет заглавную букву W , в то время как данные реагируют на ввод с именем input$weight в нижнем регистре w .

SIDENOTE: Ваш пользовательский интерфейс выглядит странным образом. Обычно вы помещаете все входы / выходы внутри sidebarPanel или mainPanel, а не после.

Результирующий код: 

library(shiny)
ui = fluidPage(
  # this is an input object   
  titlePanel("Underwriting Prediction Model"),
  sidebarLayout(position = "left",
                sidebarPanel(
                  numericInput(inputId='age', label='Age', value = 18,min = NA, max = NA, step = NA,width = NULL),
                  checkboxGroupInput(inputId='gender', label='Gender', c('male','female'), selected = NULL, 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)
                ),
                mainPanel(textOutput("Pred")))
)

server = function (input,output) {
  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())
  })

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

shinyApp(ui=ui,server=server)
0 голосов
/ 30 октября 2018

У вас есть дублированный вывод 'Pred', поэтому блестящий ничего не может сделать (в mainPanel и после всех входов в пользовательском интерфейсе). Удалить последнее и делать то, что вам нужно дальше.

...