基于Shiny的葡萄酒数据集二分类逻辑回归实现求助

I've gone through your code and identified several key issues preventing it from working correctly—like undefined variables, incomplete reactive logic, and missing data processing steps. Below is a fully functional version of your app, tailored to your goal of building a binary logistic regression model on the UCI Wine Dataset.

Key Improvements Made: #

• Added automatic fallback to load the UCI Wine Dataset if no file is uploaded (so you don't have to manually upload it every time)
• Implemented proper binary classification conversion (select any two classes from 1/2/3)
• Fixed reactive data processing and model fitting logic
• Added validation to prevent errors when inputs are incomplete
• Included meaningful outputs: model summary, confusion matrix, and interactive plots

Corrected UI Code #

shinyUI(navbarPage(
  "Wine Data Set Analysis",
  
  # Tab 1: Data Import & Configuration
  tabPanel("Data Import and Configuration",
           sidebarLayout(
             sidebarPanel(
               fileInput("file", "Upload CSV file", multiple = FALSE),
               tags$hr(),
               h5(helpText("File parameters")),
               checkboxInput(inputId = 'header', label = 'Header', value = TRUE),
               radioButtons(inputId = 'sep', label = 'Separator', 
                            choices = c(Comma=',', Semicolon=';', Tab='\t', Space=' '), 
                            selected = ','),
               tags$hr(),
               h5(helpText("Binary Classification Setup")),
               selectInput("target_col", "Select Target Column (Class)", choices = NULL),
               selectInput("class1", "First Class (Label 0)", choices = c(1,2,3), selected = 1),
               selectInput("class2", "Second Class (Label 1)", choices = c(1,2,3), selected = 3),
               tags$hr(),
               h5(helpText("Select Predictor Features")),
               checkboxGroupInput("predictors", "Independent Variables", choices = NULL)
             ),
             mainPanel(
               uiOutput("data_summary")
             )
           )
  ),
  
  # Tab 2: Logistic Regression Results
  tabPanel("Logistic Regression",
           sidebarLayout(
             sidebarPanel(
               helpText("Model Parameters"),
               numericInput("prob_threshold", "Probability Threshold", value = 0.5, min = 0.1, max = 0.9)
             ),
             mainPanel(
               tabsetPanel(
                 tabPanel("Model Summary", verbatimTextOutput("model_summary")),
                 tabPanel("Confusion Matrix", tableOutput("confusion_matrix")),
                 tabPanel("Visualization", plotOutput("logistic_plot"))
               )
             )
           )
  )
))

Corrected Server Code #

library(shiny)
library(ggplot2)
library(dplyr)
library(caret)

shinyServer(function(input, output, session) {
  
  # Reactive: Load data (fallback to UCI Wine Dataset if no file uploaded)
  raw_data <- reactive({
    if (!is.null(input$file)) {
      read.table(file = input$file$datapath, 
                 sep = input$sep, 
                 header = input$header,
                 stringsAsFactors = FALSE)
    } else {
      # Load UCI Wine Dataset directly
      url <- "http://archive.ics.uci.edu/ml/machine-learning-databases/wine/wine.data"
      col_names <- c("Class", "Alcohol", "Malic_Acid", "Ash", "Alcalinity_of_Ash", 
                     "Magnesium", "Total_Phenols", "Flavanoids", "Nonflavanoid_Phenols", 
                     "Proanthocyanins", "Color_Intensity", "Hue", "OD280_OD315", "Proline")
      read.table(url, sep = ",", header = FALSE, col.names = col_names, stringsAsFactors = FALSE)
    }
  })
  
  # Update input choices once data is loaded
  observe({
    req(raw_data())
    col_names <- names(raw_data())
    updateSelectInput(session, "target_col", choices = col_names, selected = "Class")
    updateCheckboxGroupInput(session, "predictors", choices = setdiff(col_names, input$target_col), 
                             selected = "Alcohol")
  })
  
  # Reactive: Process data for binary classification
  processed_data <- reactive({
    req(raw_data(), input$target_col, input$class1, input$class2, input$predictors)
    
    # Filter to selected classes and convert to binary
    raw_data() %>%
      filter(.data[[input$target_col]] %in% c(input$class1, input$class2)) %>%
      mutate(Binary_Target = ifelse(.data[[input$target_col]] == input$class1, 0, 1)) %>%
      select(Binary_Target, all_of(input$predictors))
  })
  
  # Reactive: Fit logistic regression model
  log_model <- reactive({
    req(processed_data())
    
    # Create formula
    formula <- as.formula(paste("Binary_Target ~", paste(input$predictors, collapse = "+")))
    
    # Fit model
    glm(formula, family = binomial(), data = processed_data())
  })
  
  # Reactive: Generate predictions and confusion matrix
  model_predictions <- reactive({
    req(log_model(), processed_data(), input$prob_threshold)
    
    processed_data() %>%
      mutate(Predicted = ifelse(predict(log_model(), type = "response") >= input$prob_threshold, 1, 0))
  })
  
  # Output: Data summary
  output$data_summary <- renderUI({
    req(raw_data())
    tagList(
      h4("Raw Data Preview"),
      tableOutput("raw_table"),
      h4("Processed Binary Data Preview"),
      tableOutput("processed_table")
    )
  })
  
  output$raw_table <- renderTable({ head(raw_data(), 10) })
  output$processed_table <- renderTable({ head(processed_data(), 10) })
  
  # Output: Model summary
  output$model_summary <- renderPrint({
    req(log_model())
    summary(log_model())
  })
  
  # Output: Confusion matrix
  output$confusion_matrix <- renderTable({
    req(model_predictions())
    table(Actual = model_predictions()$Binary_Target, Predicted = model_predictions()$Predicted)
  })
  
  # Output: Logistic regression plot (for single predictor)
  output$logistic_plot <- renderPlot({
    req(log_model(), processed_data(), length(input$predictors) == 1)
    
    predictor_col <- input$predictors[1]
    
    ggplot(processed_data(), aes(x = .data[[predictor_col]], y = Binary_Target)) +
      geom_point(alpha = 0.6) +
      geom_smooth(method = "glm", method.args = list(family = "binomial"), se = TRUE, color = "red") +
      labs(title = paste("Logistic Regression: Binary Target vs", predictor_col),
           x = predictor_col, y = "Binary Target (0/1)") +
      theme_minimal()
  })
  
})

How to Use the App: #

1. Data Tab: You can either upload your own CSV or use the preloaded UCI Wine Dataset. Configure:
   • File parameters (header, separator)
   • Select which two classes to use for binary classification (default: 1 and 3)
   • Choose predictor features (default: Alcohol)
2. Logistic Regression Tab:
   • Adjust the probability threshold for classification
   • View the model summary, confusion matrix, and a plot (only shows if you select one predictor)

Key Fixes from Your Original Code: #

• Removed undefined variables (data1, f, form) and replaced with proper reactive expressions
• Added data validation using req() to prevent errors when inputs are missing
• Implemented proper binary target conversion based on user-selected classes
• Fixed model fitting logic to use the processed data correctly
• Added meaningful outputs that help interpret the model

内容的提问来源于stack exchange，提问作者Matheus da Silva