根据用户输入进行预测-闪亮

时间:2018-10-30 10:32:03

标签: model shiny

我正在尝试创建一个Web界面,我想在该界面上根据用户提供的输入对预先构建的模型进行预测。

下面是虚拟数据和模型

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

现在,我将尝试创建一个通过多个链接和人们所面临的类似问题进行引用的闪亮应用程序。我是初学者,但仍然无法解决问题。虽然运行该应用程序没有错误,但是输出(即概率)未打印在网页上的任何地方

UI代码

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)

当我提供输入值时,我的预测没有打印输出。我在渲染打印和主面板中调用了该变量,但没有看到任何输出。这是什么问题?

2 个答案:

答案 0 :(得分:1)

您的应用存在一些问题。如@fenix_fx所述,您有2个textOutput(outputId = 'Pred')发生冲突。因此,如果创建了一个输出,它将不会呈现输出。

gender输入以一个NULL值开头,因此您必须等待反应式输入,直到选择了一个值,否则将抛出错误,无法构建data.frame,因为不同的行。您可以使用req()validate(need(...))来做到这一点。我在数据反应式中放入了req(input$gender)

另一个问题是您使用性别标签 male female 构建了glm模型,但是您的checkboxGroupInput给出了 >男性女性。这将为您提供此错误,并且无法进行预测。

  

要素性别已提高到男性水平

最后一个问题是,您输入的weight的大写字母为 W ,而数据响应式的输入则等待输入的input$weight用小写的 w

侧注:您的Ui似乎是奇怪的排列方式。通常,您会将所有输入/输出放在sidebarPanelmainPanel内,而不是之后。

结果代码:

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)

答案 1 :(得分:0)

您有重复的输出'Pred',所以Shiny无法执行任何操作(在mainPanel中以及UI中的所有输入之后)。最后删除,然后执行下一步操作。