Shiny selectizeInput多选雷达图仅绘制首选项问题修复

数据老陈

2026-9-1

多选栽培品种雷达图实现修复

问题现象

需要创建支持多选栽培品种（cultivars）输入的雷达图，期望可同时选择并绘制3个品种的雷达曲线，但现有代码运行时，首个选中的选项会覆盖其余所有选中项的配置，无法实现多系列雷达图同时绘制。
原有代码逻辑为针对每个选中的输入单独定义待绘制数据集new，完全无法适配多选项同时选中的场景，原始代码如下：

library(shiny)
library(fmsb)

aroma<-data.frame(
  aroma = c(15.0, 0.0, 1.2, 1.8, 2.0, 2.6, 2.8, 1.1, 1.2, 2.6, 1.0, 2.7, 1.7, 2.5, 2.0, 1.5, 1.6, 2.4),
  leaf_size = c(15.0, 0.0, 4.6, 6.1, 4.5, 5.6, 6.5, 8.1, 6.6, 6.6, 2.6, 2.5, 2.4,5.5, 6.1, 7.5, 8.0, 7.3),
  red_stems_and_leaves = c(15.0, 0.0, 0.0, 6.0, 5.8, 7.3, 0.0, 0.0, 0.0,0.0, 0.0, 0.0, 0.0 ,0.0, 1.1, 0.0, 3.6, 12.8),
  leaf_homogeneity = c(15.0, 0.0, 13.3, 10.8, 0.0, 11.0, 11.0, 9.9, 12.0, 11.7, 13.1, 11.4, 12.0, 12.5, 10.1, 13.4, 12.0, 13.0),
  leaf_yellowing = c(15.0, 0.0, 0.0, 0.7, 0.8, 0.5, 0.5, 1.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0),
  color_intensity = c(15.0, 0.0, 5.1, 8.7, 7.4, 8.9, 7.1, 3.9, 8.8, 5.5, 7.0, 6.5, 5.6, 7.6, 6.7, 6.6, 7.2, 14.0),
  hardness = c(15.0, 0.0, 1.8, 4.4, 3.5, 2.6, 3.0, 2.9, 3.3, 2.8, 2.2, 3.0, 2.3, 2.6, 2.0, 3.9, 3.3, 2.2),
  crispness = c(15.0, 0.0, 2.9, 5.0, 4.0, 7.9, 3.5, 4.0, 3.9, 4.0, 4.6, 5.9, 4.8, 4.8, 4.5, 5.0, 5.0, 2.5),
  fibrousness = c(15.0, 0.0, 3.1, 2.6, 3.1, 3.0, 2.1, 2.8, 3.5, 3.0, 2.0, 3.3, 3.0, 2.7, 1.5, 3.6, 3.0, 2.9),
  moisture_release = c(15.0, 0.0, 3.5, 3.1, 3.1, 2.5, 2.0, 3.0, 2.5, 2.5, 2.1, 2.9, 3.9, 4.0, 3.8, 2.3, 2.0, 2.0), 
  row.names = c("max", "min", "Sorrel", "Cabbage, Red", "Kohlrabi, Purple", "Mustard, Garnet Giant", "Arugula", 
                "Pac Choi, Tokyo Bekana", "Kale, Toscano", "Mustard, Green Wave", "Tatsoi", "Mizuna, Central Red","Mustard, Wasabina", 
                "Broccoli", "Kale, Red Russian", "Radish, Daikon", "Radish, Hong Vit", "Radish, Red Rambo"))


# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Rename"),

    # Sidebar 
    sidebarLayout(
        sidebarPanel(
            selectizeInput("cultivar",
                            "Select Cultivars:",
                            choices = c("Sorrel", "Cabbage, Red", "Kohlrabi, Purple", "Mustard, Garnet Giant", "Arugula",
                                        "Pac Choi, Tokyo Bekana", "Kale, Toscano", "Mustard, Green Wave", "Tatsoi", "Mizuna, Central Red","Mustard, Wasabina",
                                        "Broccoli", "Kale, Red Russian", "Radish, Daikon", "Radish, Hong Vit", "Radish, Red Rambo"),
                            selected = "Sorrel",
                            multiple = TRUE)
        ),

        # Show a plot
        mainPanel(
           plotOutput("plot")
        )
    )
)

# Define server logic 
server <- function(input, output) {

  output$plot <- renderPlot({
    if (input$cultivar == "Sorrel") {
      new <- aroma[c(1:2, 3), ]
    }
    if (input$cultivar == "Cabbage, Red") {
      new <- aroma[c(1:2, 4), ]
    }
    if (input$cultivar == "Kohlrabi, Purple") {
      new <- aroma[c(1:2, 5), ]
    }
    if (input$cultivar == "Mustard, Garnet Giant") {
      new <- aroma[c(1:2, 6), ]
    }
    if (input$cultivar == "Arugula") {
      new <- aroma[c(1:2, 7), ]
    }
    if (input$cultivar == "Pac Choi, Tokyo Bekana") {
      new <- aroma[c(1:2, 8), ]
    }
    if (input$cultivar == "Kale, Toscano") {
      new <- aroma[c(1:2, 9), ]
    }
    if (input$cultivar == "Mustard, Green Wave") {
      new <- aroma[c(1:2, 10), ]
    }
    if (input$cultivar == "Tatsoi") {
      new <- aroma[c(1:2, 11), ]
    }
    if (input$cultivar == "Mizuna, Central Red") {
      new <- aroma[c(1:2, 12), ]
    }
    if (input$cultivar == "Mustard, Wasabina") {
      new <- aroma[c(1:2, 13), ]
    }
    if (input$cultivar == "Broccoli") {
      new <- aroma[c(1:2, 14), ]
    }
    if (input$cultivar == "Kale, Red Russian") {
      new <- aroma[c(1:2, 15), ]
    }
    if (input$cultivar == "Radish, Daikon") {
      new <- aroma[c(1:2, 16), ]
    }
    if (input$cultivar == "Radish, Hong Vit") {
      new <- aroma[c(1:2, 17), ]
    }
    if (input$cultivar == "Radish, Red Rambo") {
      new <- aroma[c(1:2, 18), ]
      
    }
    
    radarchart(new,
               seg = 20,
               title = input$variable1,
               # pcol = colors_line,
               # pfcol = colors_fill,
               plwd = 1
    )
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

问题根因

一连串独立的if判断每次匹配到对应品种时，都会完全覆盖重写new数据集，最终只会保留最后一个匹配到的品种数据，之前选中的品种数据全部丢失
冗余的硬编码判断完全没必要：fmsb::radarchart()原生支持多系列绘图，只需要保证数据集前两行为最大值、最小值行，后续每一行对应一个待绘制的品种系列即可，不需要循环逐次绘图
原代码中title = input$variable1引用了不存在的输入控件，运行会直接报错

修复后完整代码

不需要写一堆重复的if判断，直接通过行名索引选中的品种，和max、min行拼接为绘图数据集即可，同时补充了配色、半透明填充和图例方便区分不同品种：

library(shiny)
library(fmsb)

aroma<-data.frame(
  aroma = c(15.0, 0.0, 1.2, 1.8, 2.0, 2.6, 2.8, 1.1, 1.2, 2.6, 1.0, 2.7, 1.7, 2.5, 2.0, 1.5, 1.6, 2.4),
  leaf_size = c(15.0, 0.0, 4.6, 6.1, 4.5, 5.6, 6.5, 8.1, 6.6, 6.6, 2.6, 2.5, 2.4,5.5, 6.1, 7.5, 8.0, 7.3),
  red_stems_and_leaves = c(15.0, 0.0, 0.0, 6.0, 5.8, 7.3, 0.0, 0.0, 0.0,0.0, 0.0, 0.0, 0.0 ,0.0, 1.1, 0.0, 3.6, 12.8),
  leaf_homogeneity = c(15.0, 0.0, 13.3, 10.8, 0.0, 11.0, 11.0, 9.9, 12.0, 11.7, 13.1, 11.4, 12.0, 12.5, 10.1, 13.4, 12.0, 13.0),
  leaf_yellowing = c(15.0, 0.0, 0.0, 0.7, 0.8, 0.5, 0.5, 1.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0),
  color_intensity = c(15.0, 0.0, 5.1, 8.7, 7.4, 8.9, 7.1, 3.9, 8.8, 5.5, 7.0, 6.5, 5.6, 7.6, 6.7, 6.6, 7.2, 14.0),
  hardness = c(15.0, 0.0, 1.8, 4.4, 3.5, 2.6, 3.0, 2.9, 3.3, 2.8, 2.2, 3.0, 2.3, 2.6, 2.0, 3.9, 3.3, 2.2),
  crispness = c(15.0, 0.0, 2.9, 5.0, 4.0, 7.9, 3.5, 4.0, 3.9, 4.0, 4.6, 5.9, 4.8, 4.8, 4.5, 5.0, 5.0, 2.5),
  fibrousness = c(15.0, 0.0, 3.1, 2.6, 3.1, 3.0, 2.1, 2.8, 3.5, 3.0, 2.0, 3.3, 3.0, 2.7, 1.5, 3.6, 3.0, 2.9),
  moisture_release = c(15.0, 0.0, 3.5, 3.1, 3.1, 2.5, 2.0, 3.0, 2.5, 2.5, 2.1, 2.9, 3.9, 4.0, 3.8, 2.3, 2.0, 2.0), 
  row.names = c("max", "min", "Sorrel", "Cabbage, Red", "Kohlrabi, Purple", "Mustard, Garnet Giant", "Arugula", 
                "Pac Choi, Tokyo Bekana", "Kale, Toscano", "Mustard, Green Wave", "Tatsoi", "Mizuna, Central Red","Mustard, Wasabina", 
                "Broccoli", "Kale, Red Russian", "Radish, Daikon", "Radish, Hong Vit", "Radish, Red Rambo"))

# 预设配色
line_colors <- c("#E41A1C", "#377EB8", "#4DAF4A")
fill_colors <- c("#E41A1C40", "#377EB840", "#4DAF4A40")

ui <- fluidPage(
  titlePanel("栽培品种性状雷达图"),
  sidebarLayout(
    sidebarPanel(
      selectizeInput("cultivar",
                     "选择栽培品种（最多3个）:",
                     choices = setdiff(rownames(aroma), c("max","min")),
                     selected = "Sorrel",
                     multiple = TRUE,
                     options = list(maxItems = 3))
    ),
    mainPanel(
      plotOutput("plot", height = "600px")
    )
  )
)

server <- function(input, output) {
  output$plot <- renderPlot({
    # 直接拼接max、min行和选中的品种数据，不需要冗余if判断
    plot_data <- aroma[c("max", "min", input$cultivar), ]
    # 按选中数量取对应配色
    select_count <- length(input$cultivar)
    radarchart(plot_data,
               seg = 10,
               pcol = line_colors[1:select_count],
               pfcol = fill_colors[1:select_count],
               plwd = 2,
               cglcol = "grey60",
               cglty = 1,
               axislabcol = "grey20",
               vlcex = 0.9
    )
    # 添加图例
    legend("topright",
           legend = input$cultivar,
           col = line_colors[1:select_count],
           lwd = 2,
           pch = 16,
           bty = "n")
  })
}

shinyApp(ui = ui, server = server)

关键修改点

删除所有冗余的硬编码if判断，直接通过行名索引动态拼接绘图数据集，支持任意数量（不超过设置的3个上限）的品种同时选中
在selectizeInput中直接通过setdiff(rownames(aroma), c("max","min"))生成选项列表，后续新增品种时不需要手动更新选项
增加maxItems = 3参数，直接在输入层面限制最多选3个品种，符合需求
补充了线条、填充配色和图例，不同品种区分度更高
修复了原代码中不存在的input$variable1标题引用问题
调整了雷达图网格、标签的显示样式，可读性更好

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

Shiny selectizeInput多选雷达图仅绘制首选项问题修复

问题现象 #

问题根因 #

修复后完整代码 #

关键修改点 #

问题现象

问题根因

修复后完整代码

关键修改点