I'm trying to use the predict function to obtain probabilities in a logistic regression model.

The problem is in the following situation: the variables x and y change their name. First, my data:

# data
conjlog <- reactiveValues(data = {
  data.frame(
    y = c(1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0),
    x = c(53, 57, 58, 63, 55, 67, 67, 67, 43, 69, 71, 56, 70, 70, 72, 73, 56, 51,
          76, 76, 78, 79, 81))
})

The problem is that I can't do this analysis, because the names of the variables are modified. I tried to make some modifications to resolve this, like this one:

bl <- glm(
  formula = as.data.frame(reactiveValuesToList(conjlog))[, 1] ~
    as.data.frame(reactiveValuesToList(conjlog))[, 2],
  family = "binomial", data = as.data.frame(reactiveValuesToList(conjlog))
) 

But it did not work. Note that the error that appears in predict is this:

Warning: 'newdata' had 1 row but variables found have 23 rows

Which is related to this question because of the difference between the names.

My code:

library(shiny)
library(shinydashboard)

header <- dashboardHeader(title = "Dashboard")

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem(
      text = "Logistic", 
      tabName = "log1", 
      icon = icon("chart-line")
    )
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(
      titlePanel(title = "Logistic Regression"),
      tabName = "log1",
      fluidPage(
        column(
          id = "clog1", 
          width = 6, 
          box(
            title = "Probabilities", 
            flexdashboard::gaugeOutput(outputId = "glog1")
          )
        )
      )
    )
  )
)

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output) {
  
  conjlog <- reactiveValues(data = {
    data.frame(
      y = c(1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0),
      x = c(53, 57, 58, 63, 55, 67, 67, 67, 43, 69, 71, 56, 70, 70, 72, 73, 56, 51,
            76, 76, 78, 79, 81))
  })
  
  pred_logisticregression <- reactive({
    
    bl <- stats::glm(
      formula = as.data.frame(reactiveValuesToList(conjlog))[, 1] ~
        as.data.frame(reactiveValuesToList(conjlog))[, 2],
      family = "binomial", data = as.data.frame(reactiveValuesToList(conjlog))
    )
    
    predict(object = bl, data.frame(x = 53), type = "response") * 100
    
  })
  
  output$glog1 <- flexdashboard::renderGauge({
    
    flexdashboard::gauge(
      value = pred_logisticregression(), 
      min = 1,
      max = 100, 
      symbol = "%", 
      flexdashboard::gaugeSectors(colors = "#008cba"),
      label = "Probabilities"
    )
    
  })
  
}

shinyApp(ui, server)

CodePudding user response：

I think we can use y ~ x if we just call the data with conjlog$data. And we should unname() the output vector of the prediction model.

library(shiny)
library(shinydashboard)

header <- dashboardHeader(title = "Dashboard")

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem(
      text = "Logistic", 
      tabName = "log1", 
      icon = icon("chart-line")
    )
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(
      titlePanel(title = "Logistic Regression"),
      tabName = "log1",
      fluidPage(
        column(
          id = "clog1", 
          width = 6, 
          box(
            title = "Probabilities", 
            flexdashboard::gaugeOutput(outputId = "glog1")
          )
        )
      )
    )
  )
)

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output) {
  
  conjlog <- reactiveValues(data = 
    data.frame(
      y = c(1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0),
      x = c(53, 57, 58, 63, 55, 67, 67, 67, 43, 69, 71, 56, 70, 70, 72, 73, 56, 51,
            76, 76, 78, 79, 81)
      )
  )
  
  pred_logisticregression <- reactive({
    
     bl <- stats::glm(
      formula = y ~ x, 
      family = "binomial",
      data = conjlog$data
    )
  
    x <- predict(object = bl, data.frame(x = 53), type = "response") * 100
    print(x)
    x
    
  })
  
  output$glog1 <- flexdashboard::renderGauge({

    
    flexdashboard::gauge(
      value = unname(pred_logisticregression()), 
      min = 1,
      max = 100, 
      symbol = "%", 
      flexdashboard::gaugeSectors(colors = "#008cba"),
      label = "Probabilities"
    )
    
  })
  
}

shinyApp(ui, server)