我刚接触Shiny，想知道是否可以进行以下操作，我也没有在stackoverflow上找到任何示例，也没有发现github问题。
我在下面看到了以下闪亮的仪表板-我在应用程序中内置了2个数据框-现在这些只是测试数据框，一个叫做nodes_data_1，另一个叫做edges_data_1。
我希望在renderUI中使用它的原因是因为我希望它使用反应性node_data_reactive()-因为将来这种情况可能会有所改变，因此对我来说更容易。
这里称为nodes_data_1的数据框是重要的-我想要一种方法，以便当用户单击侧边栏单选按钮“食物类型”时-
标签面板将基于nodes_data_1$Food列中的唯一值创建（具有5个值），因此将有5个单独的标签面板全部位于此大标签框中。
然后，在此之后，在每个选项卡面板中，将显示与nodes_data_1$Product_name中位于nodes_data_1$Food category中的值相对应的复选框。
例如，该应用将如下所示：
Outcome I want in the Shiny Dashboard
在这里您可以在仪表板上看到-当我在“食用”选项卡面板上时-可供选择的选项是食品“食用”类别中的数据中的那些选项
请参见下面的代码-我不知道如何创建这样的东西-欢迎任何想法-新颖的光泽，希望这是可能的！
library(shiny)
library(shinydashboard)
library(tidyverse)
library(magrittr)
header <- dashboardHeader(
title = "My Dashboard",
titleWidth = 500
)
siderbar <- dashboardSidebar(
sidebarMenu(
# Add buttons to choose the way you want to select your data
radioButtons("select_by", "Select by:",
c("Food Type" = "Food",
"Gym Type" = "Gym",
"TV show" = "TV"))
)
)
body <- dashboardBody(
fluidRow(
uiOutput("Output_panel")
),
tabBox(title = "RESULTS", width = 12,
tabPanel("Visualisation",
width = 12,
height = 800
)
)
)
ui <- dashboardPage(header, siderbar, body, skin = "purple")
server <- function(input, output, session) {
nodes_data_1 <- data.frame(id = 1:15,
Food = as.character(c("Edibles", "Fried", "Home Cooked", "packaged", "vending machine")),
Product_name = as.character(c("Bacon", "Cheese", "eggs", "chips", "beans", "oast", "oats and beans", "fried beans", "chickpeas", "broad beans", "garbanzo", "oat bars", "dog meat", "cat food", "horse meat")),
Gym_type = as.character(paste("Gym", 1:15)), TV =
sample(LETTERS[1:3], 15, replace = TRUE))
# build a edges dataframe
edges_data_1 <- data.frame(from = trunc(runif(15)*(15-1))+1,
to = trunc(runif(15)*(15-1))+1)
# create reactive of nodes
nodes_data_reactive <- reactive({
nodes_data_1
}) # end of reactive
# create reacive of edges
edges_data_reactive <- reactive({
edges_data_1
}) # end of reactive
# The output panel differs depending on the how the data is selected
# so it needs to be in the server section, not the UI section and created
# with renderUI as it is reactive
output$Output_panel <- renderUI({
# When selecting by workstream and issues:
if(input$select_by == "Food") {
box(title = "Output PANEL",
collapsible = TRUE,
width = 12,
do.call(tabsetPanel, c(id='t',lapply(1:length(unique(nodes_data_reactive()$Food)), function(i) {
food <- unique(nodes_data_reactive()$Food)
tabPanel(food[i],
checkboxGroupInput(paste0("checkboxfood", i),
label = NULL,
choices = nodes_data_reactive() %>%
filter(Food == food[i]) %>%
select(Product_name) %>%
unlist(use.names = FALSE)))
} #end of function
) # end of lapply
) # end of combine c
), # end of tab panel
# add a checkbox that is a select all
actionButton(inputId = "selectall", label = "Select All Above/Deselect")
) # end of Tab box
# When selecting by the strength of links connected to the issues:
} else if(input$select_by == "Gym") {
box(title = "Output PANEL", collapsible = TRUE, width = 12,
checkboxGroupInput("select_gyms", "Select gyms you want to display", choices = unique(nodes_data_reactive()$Gym_type)
,
selected = NULL,
inline = FALSE
)# end of checkboxGroupInput
) # end of box
} else if(input$select_by == "TV") {
box(title = "Output PANEL", collapsible = TRUE, width = 12,
checkboxGroupInput("select_tvs",
"Select the tv shows you want to see",choices = sort(unique(nodes_data_reactive()$TV)),
selected = NULL,
inline = FALSE
)# end of checkboxGroupInput
) # end of box
} # end of else if
}) # end of renderUI
} # end of server
# Run the application
shinyApp(ui = ui, server = server)
答案 0 :(得分：1)
library(shiny)
library(shinydashboard)
library(tidyverse)
library(magrittr)
header <- dashboardHeader(
title = "My Dashboard",
titleWidth = 500
)
siderbar <- dashboardSidebar(
sidebarMenu(
# Add buttons to choose the way you want to select your data
radioButtons("select_by", "Select by:",
c("Food Type" = "Food",
"Gym Type" = "Gym",
"TV show" = "TV"))
)
)
body <- dashboardBody(
fluidRow(
uiOutput("Output_panel")
),
tabBox(title = "RESULTS", width = 12,
tabPanel("Visualisation",
width = 12,
height = 800
)
)
)
ui <- dashboardPage(header, siderbar, body, skin = "purple")
server <- function(input, output, session){
nodes_data_1 <- data.frame(id = 1:15,
Food = as.character(c("Edibles", "Fried", "Home Cooked", "packaged", "vending machine")),
Product_name = as.character(c("Bacon", "Cheese", "eggs", "chips", "beans", "oast", "oats and beans", "fried beans", "chickpeas", "broad beans", "garbanzo", "oat bars", "dog meat", "cat food", "horse meat")),
Gym_type = as.character(paste("Gym", 1:15)), TV =
sample(LETTERS[1:3], 15, replace = TRUE))
# build a edges dataframe
edges_data_1 <- data.frame(from = trunc(runif(15)*(15-1))+1,
to = trunc(runif(15)*(15-1))+1)
# create reactive of nodes
nodes_data_reactive <- reactive({
nodes_data_1
}) # end of reactive
# create reacive of edges
edges_data_reactive <- reactive({
edges_data_1
}) # end of reactive
# The output panel differs depending on the how the data is selected
# so it needs to be in the server section, not the UI section and created
# with renderUI as it is reactive
output$Output_panel <- renderUI({
# When selecting by workstream and issues:
if(input$select_by == "Food") {
box(title = "Output PANEL",
collapsible = TRUE,
width = 12,
do.call(tabsetPanel, c(id='t',lapply(1:length(unique(nodes_data_reactive()$Food)), function(i) {
food <- unique(sort(as.character(nodes_data_reactive()$Food)))
tabPanel(food[i],
checkboxGroupInput(paste0("checkboxfood_", i),
label = NULL,
choices = nodes_data_reactive() %>%
filter(Food == food[i]) %>%
select(Product_name) %>%
unlist(use.names = FALSE)),
checkboxInput(paste0("all_", i), "Select all", value = TRUE)
)
})))
) # end of Tab box
# When selecting by the strength of links connected to the issues:
} else if(input$select_by == "Gym") {
box(title = "Output PANEL", collapsible = TRUE, width = 12,
checkboxGroupInput("select_gyms", "Select gyms you want to display", choices = unique(nodes_data_reactive()$Gym_type)
,
selected = NULL,
inline = FALSE
)# end of checkboxGroupInput
) # end of box
} else if(input$select_by == "TV") {
box(title = "Output PANEL", collapsible = TRUE, width = 12,
checkboxGroupInput("select_tvs",
"Select the tv shows you want to see",choices = sort(unique(nodes_data_reactive()$TV)),
selected = NULL,
inline = FALSE
)# end of checkboxGroupInput
) # end of box
} # end of else if
}) # end of renderUI
observe({
lapply(1:length(unique(nodes_data_reactive()$Food)), function(i) {
food <- unique(sort(as.character(nodes_data_reactive()$Food)))
product_choices <- nodes_data_reactive() %>%
filter(Food == food[i]) %>%
select(Product_name) %>%
unlist(use.names = FALSE)
if(!is.null(input[[paste0("all_", i)]])){
if(input[[paste0("all_", i)]] == TRUE) {
updateCheckboxGroupInput(session,
paste0("checkboxfood_", i),
label = NULL,
choices = product_choices,
selected = product_choices)
} else {
updateCheckboxGroupInput(session,
paste0("checkboxfood_", i),
label = NULL,
choices =product_choices)
}
}
})
})
} # end of server
# Run the application
shinyApp(ui = ui, server = server)