仅预测 returns 值“1”。闪亮应用

Question

我正在尝试使用 shinyApp 进行预测，但似乎出了点问题，因为预测函数总是 returns 值为“1”。想不通了。

我建立了一个装袋模型。

library(ipred) #Bootstrapped Aggregation (Bagging)
df<-data.frame(var1=c(4,3,5,7,7,8,9,8,7),var2=c(3,4,2,8,6,4,9,4,5),var3=c(6,6,3,3,7,7,4,8,7),var4=c(7,6,3,7,6,5,7,5,4),var5=c(5,6,3,6,8,5,8,9,7),target=c(0,0,0,1,1,1,1,1,1))
targetvariable<-"target"
formula<-as.formula(paste0(targetvariable,"~."))

train<-df
train[[targetvariable]]<-as.factor(train[[targetvariable]])
modelo_bg <- bagging(formula, data=train)
save(modelo_bg,file="ml.R")

现在，我想要的是用这个模型来做预测。我想构建一个 shinyApp 来预测单行。这是我的 ui.R:

library(shiny)

fluidPage(
  
  titlePanel("Predictions"),
  fluidRow(
    column(3,textInput("var1", h3("var1"))),
    column(3,textInput("var2", h3("var2"))),
    column(3,textInput("var3", h3("var3"))),
    column(3,textInput("var4", h3("var4"))),
    column(3,textInput("var5", h3("var5"))),
    column(3,actionButton("predict", "Predict"))    
  ),
  fluidRow(
      textOutput("prediction")
  )
)

因为我只想使用已经构建的模型进行预测，所以我在 server.R

中加载了 R 数据文件

library(shiny)
library(ipred)

function(input, output) {
  
  vnv <- eventReactive(input$predict, {
    
    if (!exists("modelo_bg")){
      load("ml.R")
    }
        
    newrow<-c(input$var1,input$var2,input$var3,input$var4,input$var5)
    
    dtest<-data.frame()
    dtest[] <- lapply(dtest, as.numeric)
    dtest<-rbind(dtest,as.numeric(newrow))
    
    names(dtest)<-c("var1","var2","var3","var4","var5")
    
    predictions <- predict(modelo_bg, dtest)
    predictions
    
  })

  output$prediction<-renderText({
    vnv()
  })

}

...无论我试图预测什么，我总是得到值“1”。但是，如果我在控制台中为一行执行预测函数，它 returns 是正确的值。 ShinyApp 代码有什么问题？

Answer 1

而不是 renderText，使用 renderPrint。那么你的代码就可以正常工作了。

试试这个

ui <- fluidPage(
  
  titlePanel("Predictions"),
  fluidRow(
    column(3,textInput("var1", h3("var1"))),
    column(3,textInput("var2", h3("var2"))),
    column(3,textInput("var3", h3("var3"))),
    column(3,textInput("var4", h3("var4"))),
    column(3,textInput("var5", h3("var5"))),
    column(3,actionButton("predict", "Predict"))    
  ),
  fluidRow( 
    verbatimTextOutput("prediction")
  )
)

server <- function(input, output) {
  
  vnv <- eventReactive(input$predict, {
    
    # if (!exists("modelo_bg")){
    #   load("ml.R")
    # }
    
    newrow<-c(input$var1,input$var2,input$var3,input$var4,input$var5)
    
    dtest<-data.frame()
    dtest[] <- lapply(dtest, as.numeric)
    dtest<-rbind(dtest,as.numeric(newrow))
    
    names(dtest)<-c("var1","var2","var3","var4","var5")
    
    predictions <- predict(modelo_bg, dtest)
    
    predictions
    
  })
  
  output$prediction<-renderPrint({
    vnv()
  })
  
}

shinyApp(ui = ui, server = server)

仅预测 returns 值“1”。闪亮应用

Predictions only returns value "1". shinyApp

r

machine-learning

shiny

shinyapps