如何调整Shiny生成图表的图例 使其正常显示在图表下方

你代码中的问题主要有三点：

• 绘图默认底部边距不足，放在绘图区外的图例被截断无法显示
• 图例位置参数设置错误，未指定到图表下方的位置
• 图例内容、样式未和绘图元素匹配，显示逻辑不正确

修正后完整代码 #

library(shiny)
library(shinythemes)


df1 <- structure(
  list(date1= c("2021-06-28","2021-06-28","2021-06-28","2021-06-28"),
       date2 = c("2021-06-30","2021-06-30","2021-07-01","2021-07-02"),
       Category = c("FDE","ABC","FDE","ABC"),
       Week= c("Wednesday","Wednesday","Friday","Friday"),
       DR1 = c(4,1,6,1),
       DR01 = c(4,1,4,4), DR02= c(4,2,6,0),DR03= c(9,5,4,0),
       DR04 = c(5,4,3,5),DR05 = c(5,4,5,0),
       DR06 = c(2,4,3,5),DR07 = c(2,5,4,0),
       DR08 = c(3,4,5,0),DR09 = c(2,3,4,0)),
  class = "data.frame", row.names = c(NA, -4L))


ui <- fluidPage(
  
  shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                    br(),
                    tabPanel("",
                             sidebarLayout(
                               sidebarPanel(
                                 uiOutput('date'),
                                 uiOutput('mycode')
                                 
                                 
                               ),
                               mainPanel(
                                 tabsetPanel(
                                   tabPanel("", plotOutput("graph",width = "100%", height = "600")
                                 
                               )
                             ))
  ))))


server <- function(input, output,session) {
  
 data<-reactive(df1)
  
  output$date <- renderUI({
    req(data())
    all_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-15'), by = "day")
    disabled <- as.Date(setdiff(all_dates, as.Date(data()$date2)), origin = "1970-01-01")
    entrydate<- dateInput(input = "Date2", 
                          label = h4("Choose"),
                          min = min(data()$date2),
                          max = max(data()$date2),
                          format = "dd-mm-yyyy",
                          datesdisabled = disabled)
    entrydate$children[[2]]$attribs$placeholder <- "No selected date"
    entrydate
  })
  
  
  output$mycode <- renderUI({
    req(input$Date2)
    df1 <- data()
    df5 <- df1[as.Date(df1$date2) %in% input$Date2,]
    selectInput("code", label = h4("Category"),choices=c("No code selected" = "", sort(unique(df5$Category))))
  })
  
  output$graph <- renderPlot({
    df1 <- data()
    req(input$Date2,input$code)
    # 调整绘图底部边距，预留图例显示空间
    par(mar = c(7, 4, 2, 2))
    # 按分类分组绘制散点，不同分类用不同颜色区分
    plot(x=df1$DR02[df1$Category == "ABC"], y=df1$DR1[df1$Category == "ABC"], 
         col = "red", pch = 16, xlim = range(df1$DR02), ylim = range(df1$DR1),
         xlab = "DR02", ylab = "DR1")
    points(x=df1$DR02[df1$Category == "FDE"], y=df1$DR1[df1$Category == "FDE"], 
         col = "blue", pch = 16)
    # 图例设置为底部位置，向下偏移出绘图区，横向排列
    legend("bottom",inset=c(0,-0.25), 
           legend= c("ABC", "FDE"),
           col = c("red", "blue"),
           pch = 16,
           title="The number is é:",
           title.col = "black", 
           cex = 1.2,
           ncol = 2,
           bty = "n")
  })
    
}

shinyApp(ui = ui, server = server) 

参数调整说明 #

• par(mar = c(7,4,2,2))：将绘图区底部边距调整为7个单位，预留图例展示空间
• legend("bottom", inset = c(0, -0.25))：指定图例在底部位置，第二个inset参数为负表示向绘图区下方偏移
• 新增ncol=2让图例横向排列，更适配底部展示场景
• 补全了图例的颜色、点样式参数，和散点图元素对应

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