У меня нижеприведенное приложение, оно берет фрейм данных, созданный на блестящем сервере, и использует его для генерации панелей вкладок, которые, в свою очередь, устанавливают флажки на каждой панели вкладок (3 флажка на панель вкладок) - на каждой панели вкладок.есть поле «выбрать все», которое, по сути, должно проверять все поля в этой панели вкладок
Так что мне нужна помощь - это то, что я хотел бы, чтобы, если я нахожусь на вкладке 1 и«нажмите» кнопку «выбрать все», затем он «отметит» все эти поля на панели вкладок (и, разумеется, «снятие кнопки» с этой кнопки отменит выбор этих полей) - но я бы также хотел, чтобы функциональность так, чтобыесли вы установите несколько флажков на разных вкладках, то они будут обновлены соответствующим образом и не потеряют никакой информации (включая нажатие кнопки select all на разных вкладках)
Так, например, я бы хотел следующее поведение:
Если вы выберете вкладку «Съедобные»>, а затем нажмите «выбрать все» - все 3 флажка установлены
Теперь, если вы затем выберете вкладку «Жареные»> затем нажмите «сыр», который является одним из вариантов для отдельных флажков - теперь у вас будет выбрано всего 4 флажка, все из них на вкладке «съедобные» и толькоодна из «жареных» вкладок
Так что, если теперь мы отменим выбор кнопки «выбрать все» на первой вкладке «съедобные», она потеряет всю информацию и флажок в «Жареные», который был «сыр»больше не проверяется,
Это не то поведение, которое я хотел бы - я бы хотел, чтобы оно обновлялось соответствующим образом, и чтобы "сыр" оставался выбранным, поскольку мы не нажали, выберите все
Я распечатал названия того, что выбирается, где и когда в самом приложении
код ниже:
Есть мысли?
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") {
food <- unique(as.character(nodes_data_reactive()$Food))
food_panel <- lapply(seq_along(food), function(i) {
### filter the data only once
food_dt <- dplyr::filter(nodes_data_reactive(), Food == food[i])
### Use the id, not the price, as the id is unique
food_ids <- as.character(food_dt$id)
selected_ids <- food_ids[food_ids %in% isolate({chosen_food()})] ### use isolate, so as to not be reactive to it
tabPanel(food[i],
checkboxGroupInput(
paste0("checkboxfood_", i),
label = "Random Stuff",
choiceNames = as.character(food_dt$Product_name), ### for some reason it likes characters, not factors with extra levels
choiceValues = food_ids,
selected = selected_ids
),
checkboxInput(
paste0("all_", i),
"Select all",
value = all(food_ids %in% isolate({chosen_food()}))
)
)
})
box(title = "Output PANEL",
collapsible = TRUE,
width = 12,
do.call(tabsetPanel, c(id = 't', food_panel)),
"Items: ", renderText(paste0(chosen_food(), collapse = ", ")),
"Names: ", renderText(paste0(chosen_food_names(), collapse = ", "))
) # end of Tab box
}
}) # 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) %>%
as.character()
product_prices <- nodes_data_reactive() %>%
filter(Food == food[i]) %>%
select(Price) %>%
unlist(use.names = FALSE)
if(!is.null(input[[paste0("all_", i)]])){
if(input[[paste0("all_", i)]] == TRUE) {
updateCheckboxGroupInput(session,
paste0("checkboxfood_", i),
label = NULL,
choiceNames = product_choices,
choiceValues = product_prices,
selected = product_prices)
} else {
updateCheckboxGroupInput(session,
paste0("checkboxfood_", i),
label = NULL,
choiceNames = product_choices,
choiceValues = product_prices,
selected = c()
)
}
}
})
})
chosen_food <- reactive({
unlist(lapply(seq_along(unique(nodes_data_reactive()$Food)), function(i) {
# retrieve checkboxfood_NUMBER value
input[[paste0("checkboxfood_", i)]]
}))
})
chosen_food_names <- reactive({
# turn selected chosen food values into names
nodes_data_reactive()$Product_name[as.numeric(chosen_food())]
})
} # end of server
# Run the application
shinyApp(ui = ui, server = server)