R Shiny中ggplot绘制箱线图异常（仅显示线条）问题求助

问题原因 #

你的目标变量Antwortkategorie是分类因子类型，而geom_boxplot()需要基于连续数值变量来计算四分位数、中位数等箱线图核心统计量。直接用因子作为y轴时，ggplot只能展示每个类别单一值的线条，无法生成标准箱线图结构。

解决方案 #

将因子变量转换为对应的连续数值（基于因子的预设水平顺序），让ggplot能计算箱线图所需统计量，同时保留原因子的标签作为坐标轴刻度，保证可读性。

修改后的完整代码 #

library(shiny)
library(shinydashboard)
library(dplyr)
library(DT)
library(ggplot2)
library(likert)


levels.netusoft <- c("Sehr wenig", "Etwas", "Stark", "Sehr stark", "Verweigert", 
                     "Weiß nicht", "Keine Antwort")
levels.ppltrst <- c("1", "2", "3", "4", "5", "6", "Verweigert", "Weiß nicht", 
                    "Keine Antwort")
levels.polintr <- c("Überhaupt nicht", "Sehr wenig", "Etwas", "Stark", "Sehr stark", 
                    "Verweigert", "Weiß nicht", "Keine Antwort")
levels.psppsgva <- c("Überhaupt nicht fähig", "Wenig fähig", "Ziemlich fähig", 
                     "Sehr fähig", "Vollkommen fähig", "Verweigert", "Weiß nicht", 
                     "Keine Antwort")
levels.actrolga <- c("Wenig fähig", "Ziemlich fähig", "Sehr fähig", "Vollkommen fähig", 
                     "Verweigert", "Weiß nicht", "Keine Antwort")
levels.gndr <- c("männlich", "weiblich")

dataset <- data.frame("netusoft" = factor(sample(levels.netusoft, 100, 
                                                 replace = TRUE),
                                          levels.netusoft),
                      "ppltrst" = factor(sample(levels.ppltrst, 100, 
                                                replace = TRUE),
                                         levels.ppltrst),
                      "polintr" = factor(sample(levels.polintr, 100, 
                                                replace = TRUE),
                                         levels.polintr),
                      "psppsgva" = factor(sample(levels.psppsgva, 100, 
                                                 replace = TRUE),
                                          levels.psppsgva),
                      "actrolga" = factor(sample(levels.actrolga, 100, 
                                                 replace = TRUE),
                                          levels.actrolga),
                      "gndr" = factor(sample(levels.gndr, 100,
                                             replace = TRUE),
                                      levels.gndr),
                      check.names = FALSE)



# ----- UI
ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title = "Test Shiny Dashboard", 
                    titleWidth = 300),
    dashboardSidebar(width = 300,
                     selectInput(inputId = "round", 
                                 label = "Wählen Sie eine Runde aus",  
                                 c("Runde 9" = "9"),
                                 selected = "9", selectize = FALSE), 
                     #end selectinput
                     conditionalPanel(
                       condition = "input.round == '9'",
                       selectInput(inputId = "battery", 
                                   label = "Wählen Sie Themenfeld aus",
                                   c("A: Medien-, Internetnutzung, Soziales Vertrauen" = "A",
                                     "B: Politische Variablen, Immigration" = "B"), 
                                   selectize = FALSE), #end selectinput
                       uiOutput("question_placeholder")
                     ),
                     checkboxInput(
                       inputId = "group",
                       label = "Daten gruppieren",
                       value = FALSE), #end checkbox
                     
                     conditionalPanel(
                       condition = "input.group == true",
                       selectInput(
                         inputId = "UV",
                         label = "Daten gruppieren nach:",
                         c("Geschlecht" = "gndr")
                       ) # end conditionalPanel
                     )
    ), # end dashboardSidebar
    dashboardBody(
      fluidRow(
        
        box(width = 8, status = "info", solidHeader = TRUE,
            title = "Graph:",
            plotOutput("plot", width = "auto", height = 500)
        )
      ), # end fluidRow
      
    
      
    ) #end dashboardBody
  )
)

server <- function(input, output, session) {
  get_data <- reactive({
    req(input$question)
    if (input$group) {
      dataset %>% 
        select(Antwortkategorie = input$question, grp = !!as.symbol(input$UV)) %>% 
        # 添加因子对应的数值列
        mutate(value = as.integer(Antwortkategorie))
    } else {
      dataset %>% 
        select(Antwortkategorie = input$question) %>% 
        # 添加因子对应的数值列
        mutate(value = as.integer(Antwortkategorie))
    } 
  })
 

  
  output$question_placeholder <- renderUI({
    if (input$battery == "A") {
      choices <- c("A2|Häufigkeit Internetnutzung" = "netusoft",
                   "A4|Vertrauen in Mitmenschen" = "ppltrst")
    } else if (input$battery == "B") {
      choices <- c("B1|Interesse an Politik" = "polintr",
                   "B2|Politische Mitsprachemöglichkeit" = "psppsgva",
                   "B3|Fähigkeit politischen Engagements " = "actrolga")
    }
    selectInput(inputId = "question", 
                label = "Wählen Sie eine Frage aus",
                choices,
                selectize = FALSE)
  })
  

  theplot <- reactive({
    # 获取因子水平用于轴标签
    factor_levels <- levels(get_data()$Antwortkategorie)
    
    if(!input$group) {
      p <- get_data() %>%
        ggplot(mapping = aes(y = value)) + 
        geom_boxplot() +
        # 将y轴刻度替换为原因子标签
        scale_y_continuous(breaks = seq_along(factor_levels), 
                           labels = factor_levels) +
        labs(y = input$question)
    } else {
      p <- get_data() %>%
        ggplot(mapping = aes(x=grp, y=value)) + 
        geom_boxplot() +
        scale_y_continuous(breaks = seq_along(factor_levels), 
                           labels = factor_levels) +
        labs(x = "Geschlecht", y = input$question)
    }
    p
  })
  
  
  output$plot <- renderPlot({
    theplot()
  })
  

}

shinyApp(ui, server)

关键修改点 #

• 在get_data()中新增value = as.integer(Antwortkategorie)，将因子转换为连续数值（对应因子水平的顺序）
• 绘图时用value作为y轴变量，通过scale_y_continuous()将y轴刻度替换为原因子的文本标签，保证图表可读性
• 移除了原代码中不必要的group_by()（箱线图会自动处理分组统计，不需要提前分组）

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