Почему бы не использовать sidebarLayout с navbarPage в mainPanel?
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("select", "Select", c("a", "b", "c"))
),
mainPanel(
navbarPage(
"App Title",
tabPanel("Plot"),
tabPanel("Summary"),
tabPanel("Table")
)
)
)
)
shinyApp(ui, server)
РЕДАКТИРОВАТЬ
Или что-то вроде этого?
library(shiny)
library(ggplot2)
ui <- fluidPage(
div(
style = "display: flex; flex-direction: column;",
div( #~~ Main panel ~~#
navbarPage(
"Old Faithful Geyser Data",
tabPanel(
"Plot",
plotOutput("ggplot")
),
tabPanel("Summary"),
tabPanel("Table")
)
),
wellPanel( #~~ Sidebar ~~#
style = "width: 300px;",
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
)
)
)
server <- function(input, output) {
output[["ggplot"]] <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui = ui, server = server)
РЕДАКТИРОВАТЬ
Вот так, чтобы боковая панель была слева:
library(shiny)
library(shinyjs)
library(ggplot2)
CSS <- "
.sidebar {
min-width: 300px;
margin-right: 30px;
}
#sidebar {
width: 300px;
}
"
ui <- fluidPage(
useShinyjs(),
tags$head(tags$style(HTML(CSS))),
div( #~~ Main panel ~~#
navbarPage(
"Old Faithful Geyser Data",
tabPanel(
"Plot",
div(
style = "display: flex;",
div(class = "sidebar"),
plotOutput("ggplot")
)
),
tabPanel(
"Summary",
div(
style = "display: flex;",
div(class = "sidebar"),
verbatimTextOutput("summary")
)
),
tabPanel(
"Table",
div(
style = "display: flex;",
div(class = "sidebar"),
tableOutput("table")
)
),
id = "navbar"
)
),
wellPanel( #~~ Sidebar ~~#
id = "sidebar",
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
)
)
server <- function(input, output) {
output[["ggplot"]] <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output[["summary"]] <- renderPrint({
list(a = 1:10, b = 1:10)
})
output[["table"]] <- renderTable({
iris[1:10,]
})
observeEvent(input[["navbar"]], {
selector <-
sprintf("$('div.tab-pane[data-value=\"%s\"] div.sidebar')", input[["navbar"]])
runjs(paste0(selector, ".append($('#sidebar'));"))
})
}
shinyApp(ui = ui, server = server)
РЕДАКТИРОВАТЬ
Вот улучшение описанного выше способа. Я сделал несколько удобных функций tabPanel2 и sidebar, чтобы помочь пользователю. И я использую fluidRow и column вместо display: flex;. Это позволяет иметь ширину боковой панели относительно размера экрана. В приведенном ниже примере также показано, как не включать боковую панель во вкладку (просто используйте tabPanel, а не tabPanel2.
library(shiny)
library(shinyjs)
library(ggplot2)
tabPanel2 <- function(title, ..., value = title, icon = NULL, sidebarWidth = 4){
tabPanel(
title = title,
fluidRow(
column(
width = sidebarWidth,
class = "sidebar"
),
column(
width = 12 - sidebarWidth,
...
)
)
)
}
sidebar <- function(...){
div(
style = "display: none;",
tags$form(
class = "well",
id = "sidebar",
...
)
)
}
ui <- fluidPage(
useShinyjs(),
div( #~~ Main panel ~~#
navbarPage(
"Old Faithful Geyser Data",
tabPanel2(
"Plot",
plotOutput("ggplot")
),
tabPanel2(
"Summary",
verbatimTextOutput("summary")
),
tabPanel(
"Table",
fluidRow(
column(
width = 4,
wellPanel(
tags$fieldset(
tags$legend(h3("About")),
p("This app is cool")
)
)
),
column(
width = 8,
tableOutput("table")
)
)
),
id = "navbar"
)
),
sidebar( #~~ Sidebar ~~#
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30)
)
)
server <- function(input, output) {
output[["ggplot"]] <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output[["summary"]] <- renderPrint({
list(a = 1:10, b = 1:10)
})
output[["table"]] <- renderTable({
iris[1:10,]
})
observeEvent(input[["navbar"]], {
selector <-
sprintf("$('div.tab-pane[data-value=\"%s\"] div.sidebar')", input[["navbar"]])
append <- "selector.append($('#sidebar'));"
js <- sprintf("var selector=%s; if(selector.length){%s;}", selector, append)
runjs(js)
})
}
shinyApp(ui = ui, server = server)