当前拥有以下应用程序
我希望将选择值和选择名称选择添加到服务器中观察功能的Shiny应用中，以便在用户单击时全选-以便复选框使用正确的名称更新-但它们仍然具有nodes_data_reactive()$Price列中的值？
因此，如果我选择“食用标签”>然后全选-它应使用所有正确的名称更新复选框-但product_choices中的基础值应为“价格”列中的值。我该怎么办？
例如食用标签>选择全部>培根的基础值为1，鹰嘴豆为11等
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")),
Price = c(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"che
# 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 = "Random Stuff",
choiceNames = unique(nodes_data_reactive()$Product_name[
nodes_data_reactive()$Food == unique(nodes_data_reactive()$food)[i]]), choiceValues = unique(nodes_data_reactive()$Price[
nodes_data_reactive()$Food == unique(nodes_data_reactive()$food)[i]])
),
checkboxInput(paste0("all_", i), "Select all", value = FALSE)
)
})))
) # 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
) # end of box
} else if(input$select_by == "TV") {
box(title = "Output PANEL", collapsible = TRUE, width = 12
) # 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,
# Over here i want to use choice Names and choice Values not choices
choices = product_choices,
selected = product_choices)
} else {
updateCheckboxGroupInput(session,
paste0("checkboxfood_", i),
label = NULL,
choices = product_choices)
}
}
})
})
View(product_choices)
} # end of server
# Run the application
shinyApp(ui = ui, server = server)