Sam S.
Reputation: 803
RStudio shiny to shiny dashboard
Here is my code for R shiny (only UI part):
library(shiny)
library(shinythemes)
library(wordcloud2)
ui <- navbarPage(
title = "Title of App",
tabPanel("Category 1",icon = icon("search"),
fluidPage(theme = shinytheme("united"),
headerPanel("header for title 1"),
titlePanel(h3("title for category 1")),
wellPanel(tags$style(type="text/css", '#leftPanel { width:200px; float:left;}'),
id = "leftPanel",
conditionalPanel(condition="input.tb1=='1'",
textInput("sc_number", h5("Enter a Number:"), 10)
),
conditionalPanel(condition="input.tb1=='2'",
textInput("string_1", h5("Enter String:"), "string here")
),
br(),
selectInput("group_text_1", "Select Groups",
choices = c("gr1","gr2","gr3"),
selected = "gr1",
multiple = TRUE),
br(),
actionButton(inputId = "GoButton_1", label = "Go", icon("refresh"))
),
mainPanel(
tabsetPanel(
tabPanel(value="1", "Tab #1", hr(), DT::dataTableOutput("sc_table_number")),
tabPanel(value="2", "Tab #2" , hr(), DT::dataTableOutput("sc_table_date")),
id = "tb1")
)
)
),
tabPanel("Category 2",icon = icon("search-plus"),
fluidPage(
headerPanel("header 2"),
titlePanel(h2("title 2")),
wellPanel(tags$style(type="text/css", '#leftPanel { width:200px; float:left;}'),
id = "leftPanel",
conditionalPanel(condition="input.tb2=='1'",
textInput("string_2", h5("Enter String:"), "able to update string")
),
br(),
checkboxGroupInput('swords', 'Select words:',
c("pain","massage","physio",
"family","angry","upset","stress","complain"),
selected = c("pain","massage")),
br(),
actionButton(inputId = "GoButton_2", label = "Go", icon("refresh"))
),
mainPanel(
tabsetPanel(
tabPanel(value="1","Tab #1",
helpText("data:"), hr(), DT::dataTableOutput("se_doc")
),
tabPanel("Tab #2",
wordcloud2Output("se_search_cloud",width = "100%")
),
id = "tb2")
)
)
)
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
My main question is how can I convert this code to shinydashboard. Particularly how conditionalPanel works in shinydashboard.
I believe my code is not efficient; particularly for the following issues:
I have "Select words" and I like to have them similar to "Select Groups" but with checkbox. Using selectInput with multiple=TRUe does not show checkbox.
I also used similar variables such as "string_1 and string_2" and "GoButton_1 and GoButton_2", but they are for the same purpose. Can I name both with one variable such as "string" and "GoButton"?
Here is a screenshot from my shiny.
I appreciate your updates and comments to improve the code.
Thanks, Sam
Upvotes: 1
Views: 1544
Answers (1)
Eli Berkow
Reputation: 2725
Please try this and let me know what you think
library(shiny)
library(shinythemes)
library(wordcloud2)
library(shinydashboard)
ui <- dashboardPage(dashboardHeader(title = "Title of App"),
sidebar = dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem(text = "Category 1",tabName = "Category_1",icon = icon("search")),
menuItem(text = "Category 2",tabName = "Category_2",icon = icon("search-plus"))
)
),
body = dashboardBody(
tabItems(
tabItem(tabName = "Category_1",
fluidPage(theme = shinytheme("united"),
headerPanel("header for title 1"),
titlePanel(h3("title for category 1")),
wellPanel(tags$style(type="text/css", '#leftPanel { width:200px; float:left;}'),
id = "leftPanel",
conditionalPanel(condition="input.tb1=='1'",
textInput("sc_number", h5("Enter a Number:"), 10)
),
conditionalPanel(condition="input.tb1=='2'",
textInput("string_1", h5("Enter String:"), "string here")
),
br(),
selectInput("group_text_1", "Select Groups",
choices = c("gr1","gr2","gr3"),
selected = "gr1",
multiple = TRUE),
br(),
actionButton(inputId = "GoButton_1", label = "Go", icon("refresh"))
),
mainPanel(
tabsetPanel(
tabPanel(value="1", "Tab #1", hr(), DT::dataTableOutput("sc_table_number")),
tabPanel(value="2", "Tab #2" , hr(), DT::dataTableOutput("sc_table_date")),
id = "tb1")
)
)
),
tabItem(tabName = "Category_2",
fluidPage(
headerPanel("header 2"),
titlePanel(h2("title 2")),
wellPanel(tags$style(type="text/css", '#leftPanel { width:200px; float:left;}'),
id = "leftPanel",
conditionalPanel(condition="input.tb2=='1'",
textInput("string_2", h5("Enter String:"), "able to update string")
),
br(),
checkboxGroupInput('swords', 'Select words:',
c("pain","massage","physio",
"family","angry","upset","stress","complain"),
selected = c("pain","massage")),
br(),
actionButton(inputId = "GoButton_2", label = "Go", icon("refresh"))
),
mainPanel(
tabsetPanel(
tabPanel(value="1","Tab #1",
helpText("data:"), hr(), DT::dataTableOutput("se_doc")
),
tabPanel("Tab #2",
wordcloud2Output("se_search_cloud",width = "100%")
),
id = "tb2")
)
)
)
)
)
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
Update:
Based on further comments.
library(shiny)
library(shinythemes)
library(wordcloud2)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(dashboardHeader(title = "Title of App",
tags$li(
class = "dropdown",
tags$a(sidebarMenu(id = "tabs",
menuItem(text = "Category 1",tabName = "Category_1",icon = icon("search")),
menuItem(text = "Category 2",tabName = "Category_2",icon = icon("search-plus"))),
style = "padding-top: 0px;
padding-right: 0px;
padding-bottom: 0px;
padding-left: 0px;"
))
),
sidebar = dashboardSidebar(
div(id = "leftPanel_1", fluidPage(
textInput("sc_number", h5("Enter a Number:"), 10)
,
hidden(textInput("string_1", h5("Enter String:"), "string here")
),
br(),
selectInput("group_text_1", "Select Groups",
choices = c("gr1","gr2","gr3"),
selected = "gr1",
multiple = TRUE),
br(),
actionButton(inputId = "GoButton_1", label = "Go", icon("refresh"))
)),
hidden(div(id = "leftPanel_2", fluidPage(
textInput("string_2", h5("Enter String:"), "able to update string")
,
br(),
checkboxGroupInput('swords', 'Select words:',
c("pain","massage","physio",
"family","angry","upset","stress","complain"),
selected = c("pain","massage")),
br(),
actionButton(inputId = "GoButton_2", label = "Go", icon("refresh"))
)))
),
body = dashboardBody(
tabItems(
tabItem(tabName = "Category_1",
fluidPage(theme = shinytheme("united"),
headerPanel("header for title 1"),
titlePanel(h3("title for category 1")),
mainPanel(
tabsetPanel(
tabPanel(value="1", "Tab #1", hr(), DT::dataTableOutput("sc_table_number")),
tabPanel(value="2", "Tab #2" , hr(), DT::dataTableOutput("sc_table_date")),
id = "tb1")
)
)
),
tabItem(tabName = "Category_2",
fluidPage(
headerPanel("header 2"),
titlePanel(h2("title 2")),
mainPanel(
tabsetPanel(
tabPanel(value="1","Tab #1",
helpText("data:"), hr(), DT::dataTableOutput("se_doc")
),
tabPanel("Tab #2",
wordcloud2Output("se_search_cloud",width = "100%")
),
id = "tb2")
)
)
)
),
useShinyjs()
),
tagList(
tags$head(
tags$style(
".main-header .navbar-custom-menu {
float: left;
}
.sidebar-menu {
display: flex;
}"
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$tabs, {
toggle('leftPanel_1')
toggle('leftPanel_2')
}, ignoreInit = TRUE)
observeEvent(input$tb1, {
toggle('sc_number')
toggle('string_1')
}, ignoreInit = TRUE)
observeEvent(input$tb2, {
toggle('string_2')
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
Further Update:
Dealing with additional questions 1 and 2.
library(shiny)
library(shinythemes)
library(wordcloud2)
library(shinydashboard)
library(shinyjs)
library(shinyWidgets)
ui <- dashboardPage(dashboardHeader(title = "Title of App",
tags$li(
class = "dropdown",
tags$a(sidebarMenu(id = "tabs",
menuItem(text = "Category 1",tabName = "Category_1",icon = icon("search")),
menuItem(text = "Category 2",tabName = "Category_2",icon = icon("search-plus"))),
style = "padding-top: 0px;
padding-right: 0px;
padding-bottom: 0px;
padding-left: 0px;"
))
),
sidebar = dashboardSidebar(
div(id = "leftPanel_1", fluidPage(
textInput("sc_number", h5("Enter a Number:"), 10)
,
hidden(textInput("string_1", h5("Enter String:"), "string here")
),
br(),
selectInput("group_text_1", "Select Groups",
choices = c("gr1","gr2","gr3"),
selected = "gr1",
multiple = TRUE),
br(),
actionButton(inputId = "GoButton_1", label = "Go", icon("refresh"))
)),
hidden(div(id = "leftPanel_2", fluidPage(
textInput("string_2", h5("Enter String:"), "able to update string")
,
br(),
pickerInput('swords', 'Select words:',
c("pain","massage","physio",
"family","angry","upset","stress","complain"),
selected = c("pain","massage"), multiple = TRUE,
options = list(
`actions-box` = TRUE)),
br(),
actionButton(inputId = "GoButton_2", label = "Go", icon("refresh"))
)))
),
body = dashboardBody(
tabItems(
tabItem(tabName = "Category_1",
fluidPage(theme = shinytheme("united"),
headerPanel("header for title 1"),
titlePanel(h3("title for category 1")),
mainPanel(
tabsetPanel(
tabPanel(value="1", "Tab #1", hr(), DT::dataTableOutput("sc_table_number")),
tabPanel(value="2", "Tab #2" , hr(), DT::dataTableOutput("sc_table_date")),
id = "tb1")
)
)
),
tabItem(tabName = "Category_2",
fluidPage(
headerPanel("header 2"),
titlePanel(h2("title 2")),
mainPanel(
tabsetPanel(
tabPanel(value="1","Tab #1",
helpText("data:"), hr(), DT::dataTableOutput("se_doc")
),
tabPanel("Tab #2",
wordcloud2Output("se_search_cloud",width = "100%")
),
id = "tb2")
)
)
)
),
useShinyjs()
),
tagList(
tags$head(
tags$style(
".main-header .navbar-custom-menu {
float: left;
}
.sidebar-menu {
display: flex;
}"
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$tabs, {
toggle('leftPanel_1')
toggle('leftPanel_2')
}, ignoreInit = TRUE)
observeEvent(input$tb1, {
toggle('sc_number')
toggle('string_1')
}, ignoreInit = TRUE)
observeEvent(input$tb2, {
toggle('string_2')
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
The above adds a pickerInput from the shinyWidgets package that allows for check marks alongside choices. I have further added the select all/deselect all options.
Below is a way of adding one GoButton after the other sidebar items. However you did not specify the accompanying functionality so I am not sure that this is useful as each "GoButton" presumably does different things. So too with the textInputs. It may be better to separate them from the start. The "string" textInputs are also trickier as they need to be displayed under different conditions.
fluidPage(
br(),
actionButton(inputId = "GoButton", label = "Go", icon("refresh"))
)
Upvotes: 3