RStudio闪亮的仪表板
这是我的R Shiny代码（仅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)
我的主要问题是如何将该代码转换为Shinydashboard。特别是conditionalPanel在Shinydashboard中的工作方式。
我认为我的代码效率不高；特别是针对以下问题：
-
我有“选择单词”，我希望它们类似于“选择组”，但带有复选框。将selectInput与multiple = TRUe一起使用不会显示复选框。
-
我还使用了类似的变量，例如“ string_1和string_2”以及“ GoButton_1和GoButton_2”，但它们是出于相同的目的。我可以使用“ string”和“ GoButton”之类的一个变量来命名吗？
这是我闪亮的屏幕截图。
感谢您为改进代码所做的更新和评论。
谢谢， 山姆
1 个答案:
答案 0 :(得分：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)
上面的代码从shinyWidgets包中添加了一个pickerInput，它允许在选择旁边带有复选标记。我进一步添加了全选/取消全选选项。
以下是一种在其他侧边栏项目之后添加一个GoButton的方法。但是，您没有指定附带的功能，因此我不确定这是否有用，因为每个“ GoButton”可能执行不同的操作。 textInputs也是如此。最好一开始就将它们分开。 “ string” textInputs也很麻烦，因为它们需要在不同的条件下显示。
fluidPage(
br(),
actionButton(inputId = "GoButton", label = "Go", icon("refresh"))
)
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？