RStudio 闪亮到闪亮的仪表板答案

【问题标题】：RStudio shiny to shiny dashboardRStudio 闪亮到闪亮的仪表板
【发布时间】：2019-02-12 08:36:21
【问题描述】：

这是我的 R 闪亮代码（仅 UI 部分）：

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)

我的主要问题是如何将此代码转换为闪亮仪表板。特别是 conditionalPanel 在 shinydashboard 中的工作原理。

我认为我的代码效率不高；特别是针对以下问题：

我有“选择单词”，我希望它们类似于“选择组”，但带有复选框。将 selectInput 与 multiple=TRUE 一起使用不会显示复选框。
我也使用了类似的变量，例如“string_1 and string_2”和“GoButton_1 and GoButton_2”，但它们的目的相同。我可以用一个变量来命名，比如“string”和“GoButton”吗？

这是我闪亮的截图。

感谢您的更新和 cmets 以改进代码。

谢谢，山姆

【问题讨论】：

标签： r shiny shinydashboard

【解决方案1】：

请试试这个，让我知道你的想法

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)

更新：

基于进一步的 cmets。

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)

进一步更新：

处理附加问题 1 和 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)

上面添加了来自 shinyWidgets 包的 pickerInput ，它允许在选项旁边添加复选标记。我进一步添加了全选/取消全选选项。

下面是在其他侧边栏项目之后添加一个 GoButton 的方法。但是，您没有指定附带的功能，所以我不确定这是否有用，因为每个“GoButton”可能会做不同的事情。 textInputs 也是如此。从一开始就将它们分开可能会更好。 “字符串”文本输入也比较棘手，因为它们需要在不同的条件下显示。

fluidPage(
                          br(),
                          actionButton(inputId = "GoButton", label = "Go",  icon("refresh"))
                        )

【讨论】：

非常感谢 Eli 的回答，当您单击类别时，是否可以将类别带到标题（在“应用程序标题”前面）和左侧的侧边栏面板，完全相似到我的截图。您还有任何 cmets 或我的其他问题（1 和 2）吗？
很高兴能帮上忙，山姆。不幸的是，直到下周星期三我才能看到太多。查看此链接以了解您的问题 1 - github.com/dreamRs/shinyWidgets#select-picker
感谢 Eli 提供的链接。
您好 Eli，您对我的问题有任何更新吗？我想在标题（或侧边栏）前面有类别 1 和类别 2。但是，当单击它们中的每一个时，可以在侧边栏中看到与它们相关的输入。在您的代码中，输入位于dashboardbody 中。
嗨，Sam，抱歉回复延迟。请参阅上面的更新答案......以及进一步更新的答案。如有必要，请安装软件包 shinyjs 和 shinyWidgets。