Predictions only returns value "1". shinyApp-CodePudding

I am trying to make predictions using a shinyApp but it seems something is wrong because the predict function allways returns value "1". I cant figure out.

I built a bagging model.

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

Now, what I want is to use this model to make predictions. I want to build a shinyApp to make a prediction for a single row. This is my 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")
  )
)

Since I just want to make predictions using a model already built, I load the R Data file in my server.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()
  })

}

... And no matter what I try to predict, I allways get the value "1". However if I execute predict function in the console for a single row, it returns the proper value. What is wrong in ShinyApp code?

CodePudding user response：

Instead of renderText, use renderPrint. Then your code works fine.

Try this

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)