RStudio приборная панель от блестящей до блестящей

Question

Вот мой код для R глянцевый (только часть пользовательского интерфейса):

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)

Мой главный вопрос - как мне преобразовать этот код в shinydashboard. В частности, как работает условная панель в шинидашборде.

Я считаю, что мой код неэффективен; особенно по следующим вопросам:

1. У меня есть «Выбрать слова», и мне нравится, когда они похожи на «Выбрать группы», но с флажком. При использовании selectInput с множественным значением = TRUe флажок не отображается.

2. Я также использовал похожие переменные, такие как «string_1 and string_2» и «GoButton_1 and GoButton_2», но они предназначены для той же цели. Могу ли я назвать оба с одной переменной, такой как "строка" и "GoButton"?

Вот скриншот с моей блестящей.

Я ценю ваши обновления и комментарии по улучшению кода.

Спасибо, Sam

Answer 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)

Обновление:

На основании дальнейших комментариев.

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)

Выше добавлен параметр pickerInput из пакета блестящих виджетов, который позволяет ставить галочки рядом с выбором. Далее я добавил выбрать все / отменить выбор всех вариантов.

Ниже приведен способ добавления одного GoButton после других элементов боковой панели. Однако вы не указали сопутствующую функциональность, поэтому я не уверен, что это полезно, поскольку каждый «GoButton» предположительно делает разные вещи. То же самое с textInputs. Может быть, лучше отделить их от начала. «Строковые» textInputs также более хитры, поскольку они должны отображаться в различных условиях.

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