含有效N/A的Shiny App列不存在错误的修复方案问询

以下是修复后的完整代码，附带关键修复说明：

# 加载所需包
library(shiny)
library(shinyWidgets)
library(dplyr)

# 用户提供的真实数据
raw_data <- structure(list(
  Id = c(1, 2, 3, 4, 5, 6), 
  HR_DATE = c(2022484408, 2022484408, 2022484408, 2022484408, 2022484408, 2022484408), 
  Dates = c("4/12/2016", "4/13/2016", "4/14/2016", "4/15/2016", "4/16/2016", "4/17/2016"), 
  TotalSteps = c(NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_), 
  SedentaryMinutes = c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), 
  Calories = c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), 
  TotalMinutesAsleep = c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), 
  WeightPounds = c("NA,NA", "NA,NA", "NA,NA", "NA,NA", "NA,NA", "NA,NA")
), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))

# 预处理数据：统一缺失值格式、转换日期
clean_data <- raw_data %>%
  mutate(
    Dates = as.Date(Dates, format = "%m/%d/%Y"),
    WeightPounds = case_when(
      WeightPounds == "NA,NA" ~ NA_character_,
      TRUE ~ WeightPounds
    ) %>% as.numeric()
  )

ui <- fluidPage(
  selectInput("input_1", "Select ID:", choices = unique(clean_data$HR_DATE)),
  radioGroupButtons("input_2", "Select Columns:", 
                    choices = c("TotalSteps", "SedentaryMinutes", "Calories", "TotalMinutesAsleep", "WeightPounds"),
                    selected = "TotalSteps",
                    status = "default",
                    size = "normal",
                    direction = "horizontal"),
  sliderInput("input_3", "Select a date:", 
              min = min(clean_data$Dates), 
              max = max(clean_data$Dates),
              value = min(clean_data$Dates),
              format = "%m/%d/%Y"),
  plotOutput("output")
)

server <- function(input, output) {
  # 响应式获取选中的ID
  selected_id <- reactive({
    as.numeric(input$input_1)
  })
  
  # 响应式获取选中的列
  selected_column <- reactive({
    input$input_2
  })
  
  # 响应式获取选中的日期
  selected_date <- reactive({
    input$input_3
  })
  
  # 过滤数据
  filtered_data <- reactive({
    clean_data %>%
      filter(HR_DATE == selected_id(), Dates == selected_date()) %>%
      select(all_of(selected_column())) %>%
      pull()
  })
  
  # 绘制输出
  output$output <- renderPlot({
    val <- filtered_data()
    
    # 处理缺失数据情况
    if (all(is.na(val))) {
      plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
      text(1, 1, "该数据点存在缺失（N/A）", cex = 1.2)
    } else {
      # 如果有非NA值，绘制简单点图（可根据需求调整）
      plot(x = selected_date(), y = val, 
           xlab = "日期", ylab = selected_column(),
           pch = 16, col = "blue")
    }
  })
}

# 运行App
shinyApp(ui, server)

关键修复说明 #

• UI选项修正：将radioGroupButtons的choices改为带引号的列名字符串，避免R将其识别为未定义变量，解决"列不存在"的报错。
• 数据预处理：
  • 把Dates列转换为标准Date类型，确保和滑块输入的日期格式匹配。
  • 将WeightPounds列的"NA,NA"字符串转换为真正的NA，统一缺失值格式，方便后续判断。
• 响应式变量补全：新增selected_column响应式对象，获取用户选中的列名，修复过滤逻辑中变量未定义的问题。
• 基于真实数据过滤：替换原代码中随机生成的模拟数据，改用用户提供的真实数据进行筛选，确保数据逻辑一致。
• 缺失数据可视化：当筛选后的数据全为NA时，在绘图区域显示明确的缺失提示；若存在有效数据，则正常绘制图表。

内容的提问来源于stack exchange，提问作者arobbie jammer