如何为 Shiny 仪表板中的多个选项卡中的图形创建通用图例？

Question

I wish to have the same legend for 5 graphs. 2 graphs are on the 1st tab of a Shiny app and 3 graphs are on the 2nd tab.

I have made an attempt to add a legend but the legend is taking too much space on both tabs.

Can someone show me a better way of doing this?

Here is a reprex:

# Reprex.
library(shiny)
library(shinydashboard)
library(xts)
library(quantmod)
# Data Engineering.
# Some fake data.

series1 <- xts(cumsum(rnorm(365)),order.by = Sys.Date()-1:365)
series2 <- xts(cumsum(rnorm(365)),order.by = Sys.Date()-1:365)
series3 <- xts(cumsum(rnorm(365)),order.by = Sys.Date()-1:365)
series4 <- xts(cumsum(rnorm(365)),order.by = Sys.Date()-1:365)
series5 <- xts(cumsum(rnorm(365)),order.by = Sys.Date()-1:365)

# A function to make a plot from a given series.

myplot <- function(x,n) {
    chartSeries(x,theme=chartTheme("white"),name=n);
    addLines(h=c(mean(x),mean(x)+sd(x),h=mean(x)-sd(x)),col=c("red","blue","blue"))  
    }

# Setup for Shiny

ui <- dashboardPage(
    dashboardHeader(title = "Mydashboard"),
    dashboardSidebar(
        sidebarMenu(
            menuItem("Tab 1", tabName = "mytab1"),
            menuItem("Tab 2", tabName = "mytab2")
        )
    ),
    dashboardBody(
        tabItems(
            tabItem(tabName="mytab1",
                    box(plotOutput("graph1")),
                    box(plotOutput("graph2"))
                    ),
            tabItem(tabName="mytab2",
                    box(plotOutput("graph3")),
                    box(plotOutput("graph4")),
                    box(plotOutput("graph5")))
        ),
        fluidRow(
            box(plotOutput("mylegend"),width=12,height=NULL)
        )
    )
)


server <- function(input,output){
    output$graph1 <- renderPlot({
        myplot(series1,"Series 1")
    })
    output$graph2 <- renderPlot({
        myplot(series2,"Series 2")
    })   
    output$graph3 <- renderPlot({
        myplot(series3,"Series 3")
    })
    output$graph4 <- renderPlot({
        myplot(series4,"Series 4")
    })
    output$graph5 <- renderPlot({
        myplot(series5,"Series 5")
    })

# I make an empty (NULL) plot since I am interested only in the legend.    

    output$mylegend <- renderPlot({
        plot(NULL ,xaxt='n',yaxt='n',bty='n',ylab='',xlab='', xlim=c(0,.1), ylim=c(0,.1))
        legend("bottom", legend=c("Mean","+/- One Standard Deviation"),lty=c(1,1),col=c("red","blue"))
        
    })
}

shinyApp(ui,server)

I know I can do cowplot and create ONE big graph with multiple plots and a legend, but then it won't be a shiny dashboard anymore.

I wish to create a dashboard with ONE legend which happens to be the same for both tabs.

Answer 1

Here is one way of moving the legend to the sidebar.

But now there is extra white space at the bottom of Tab 1. I do not know how to fix it. Can some one please help me fix that?

ui <- dashboardPage(
    dashboardHeader(title = "Mydashboard"),
    dashboardSidebar(
        sidebarMenu(
            menuItem("Tab 1", tabName = "mytab1"),
            menuItem("Tab 2", tabName = "mytab2"),
            plotOutput("mylegend")
        )
    ),
    dashboardBody(
        tabItems(
            tabItem(tabName="mytab1",
                    fluidRow(box(plotOutput("graph1")),
                    box(plotOutput("graph2")))
                    ),
            tabItem(tabName="mytab2",
                    fluidRow(box(plotOutput("graph3")),
                             box(plotOutput("graph4"))),
                    fluidRow(box(plotOutput("graph5")))
                    )
        )        
    )
)
server <- function(input,output)({
    output$graph1 <- renderPlot({
        myplot(series1,"Series 1")
    })
    output$graph2 <- renderPlot({
        myplot(series2,"Series 2")
    })   
    output$graph3 <- renderPlot({
        myplot(series3,"Series 3")
    })
    output$graph4 <- renderPlot({
        myplot(series4,"Series 4")
    })
    output$graph5 <- renderPlot({
        myplot(series5,"Series 5")
    })
    
    output$mylegend <- renderPlot({
        par(mai=rep(0.01,4))
        plot(NULL ,xaxt='n',yaxt='n',bty='n',ylab='',xlab='', xlim=c(0,.1), ylim=c(0,.1))
        legend("center", legend=c("Mean","+/- One Standard Deviation"),lty=c(1,1),col=c("red","blue"))
        
    },height=50)
})

shinyApp(ui,server)