RStudio блестящая до блестящей приборной панели
Вот мой код для R shiny (только часть пользовательского интерфейса):
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. В частности, как conditionalPanel работает в shinydashboard.
Я считаю, что мой код неэффективен; особенно по следующим вопросам:
У меня есть «Выбрать слова», и мне нравится, когда они похожи на «Выбрать группы», но с флажком. При использовании selectInput с несколькими = TRUe флажок не отображается.
Я также использовал похожие переменные, такие как «строка_1 и строка_2» и «GoButton_1 и GoButton_2», но они служат для той же цели. Могу ли я назвать оба одной переменной, такой как «строка» и «GoButton»?
Вот скриншот с моей блестки.
Я ценю ваши обновления и комментарии по улучшению кода.
Спасибо, Сэм
Ответы 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 из пакета shinyWidgets, который позволяет ставить галочки рядом с вариантами выбора. Далее я добавил опции «Выбрать все» / «Отменить выбор всех».
Ниже приведен способ добавления одной кнопки GoButton после других элементов боковой панели. Однако вы не указали сопутствующие функции, поэтому я не уверен, что это полезно, поскольку каждая кнопка «GoButton» предположительно выполняет разные функции. То же самое и с textInputs. Возможно, лучше разделить их с самого начала. «Строка» textInputs также сложнее, поскольку их нужно отображать в разных условиях.
fluidPage(
br(),
actionButton(inputId = "GoButton", label = "Go", icon("refresh"))
)
Рад помочь, Сэм. К сожалению, я не смогу многое рассмотреть до среды, следующей на следующей неделе. Взгляните на эту ссылку, чтобы ответить на свой вопрос 1 - github.com/dreamRs/shinyWidgets#select-picker
Спасибо Эли за ссылку.
Привет, Эли, у вас есть обновления по моему вопросу? Я хотел бы иметь категорию 1 и категорию 2 перед заголовком (или на боковой панели). Но когда вы щелкаете по каждому из них, вы можете увидеть входные данные, связанные с ними, на боковой панели. В вашем коде входные данные находятся в корпусе приборной панели.
Привет, Сэм, извини за задержку с ответом. См. Обновленный ответ выше ... и дальнейший обновленный ответ. При необходимости установите пакеты shinyjs и shinyWidgets.
Спасибо Эли за отличное обновление. Теперь все в порядке. Только одна маленькая вещь: как я могу поставить «категорию 2» перед «категорией 1»? Если у меня больше категорий, лучше располагать их в одном ряду друг перед другом, чтобы было больше места для тела.
Привет Сэм. Я не совсем понимаю. В настоящее время они находятся в одном ряду. Вы хотите, чтобы они были в одном столбце в заголовке, то есть в категории 2 под категорией 1?
Если вы это имеете в виду, просто удалите .sidebar-menu {display: flex; }
Привет, Эли! На моем компьютере они находятся в одном столбце, то есть «категория 2» под «категорией 1». Я хочу, чтобы они были в одной строке, например, категория 1, категория 2. Я удалил .sidebar-menu {display: flex; } но это не влияет. Спасибо.
Привет, Сэм, теперь я понимаю. Это странно, потому что этот {display: flex} помещает их в одну строку для меня. Какой браузер вы используете?
Я тестировал Chrome и Internet Explorer с теми же результатами. Имеет .main-header .navbar-custom-menu {float: left; } отправил категории слева от заголовка или они находятся в правом верхнем углу?
Вы можете попробовать заменить flex на -webkit-box, -webkit-inline-box или inline-flex, при этом все категории будут встроены для меня. Держи меня в курсе.
Привет, Эли, большое спасибо. -webkit-box и -webkit-inline-box работали у меня. flex и inline-flex дают мне категории в одном столбце. Я использую Chrome, влияет ли это на результаты?
Я тоже использую Chrome, так что это странно. Это должна быть версия или какие-то системные настройки. В любом случае, рад, что он работает!
Привет, Эли! Большое спасибо за ваш любезный ответ и отличный ответ.
Конечно, рад, что помог.
Большое спасибо, Илай, за ваш ответ. Можно ли вынести категории в заголовок (перед «Заголовком приложения») и на боковые панели слева, когда вы нажимаете на категории, точно так же, как на моем скриншоте. Есть ли у вас какие-либо комментарии или другие мои вопросы (1 и 2)?