У меня есть следующее блестящее приложение для панели инструментов, в настоящее время это приложение генерирует флажки на фрейме данных, который я создал в разделе сервера - здесь также есть кнопка «Выбрать все», которую я хочу сделать:
1) создать реактив - (есть пример закомментированного раздела в коде, где я пытался это сделать, но это не сработало) - этот реактив должен содержать значения "id" выбранного флажка (поэтому это значенияв первом столбце базового фрейма данных)
2) Убедитесь, что это работает для этих сценариев - когда пользователь сам устанавливает флажки, а затем работает и тогда, когда пользователь нажимает «выбрать все»Кнопка - так что этот реактив будет обновлять и заполнять себя в любой из этих ситуаций
Я закомментировал некоторый код, где я пытался это, но столкнулся с ошибками и проблемами - кто-нибудь знает, как на самом деле получить эти значения идентификатора для чегоВы выбираете в флажках?это должно работать на всех вкладках, а также, если кнопка выбора все нажата или не нажата
код для справки!
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("Work Pattern" = "Workstream"))
)
)
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,
Workstream = as.character(c("Finance", "Energy", "Transport", "Health", "Sport")),
Product_name = as.character(c("Actuary", "Stock Broker", "Accountant", "Nuclear Worker", "Hydro Power", "Solar Energy", "Driver", "Aeroplane Pilot", "Sailor", "Doctor", "Nurse", "Dentist", "Football", "Basketball","Cricket")),
Salary = c(1:15))
# 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 == "Workstream") {
box(title = "Output PANEL",
collapsible = TRUE,
width = 12,
do.call(tabsetPanel, c(id='t',lapply(1:length(unique(nodes_data_reactive()$Workstream)), function(i) {
testing <- unique(sort(as.character(nodes_data_reactive()$Workstream)))
tabPanel(testing[i],
checkboxGroupInput(paste0("checkbox_", i),
label = "Random Stuff",
choiceNames = unique(nodes_data_reactive()$Product_name[
nodes_data_reactive()$Workstream == unique(nodes_data_reactive()$testing)[i]]), choiceValues = unique(nodes_data_reactive()$Salary[
nodes_data_reactive()$Workstream == unique(nodes_data_reactive()$testing)[i]])
),
checkboxInput(paste0("all_", i), "Select all", value = FALSE)
)
})))
) # end of Tab box
} # end if
}) # end of renderUI
observe({
lapply(1:length(unique(nodes_data_reactive()$Workstream)), function(i) {
testing <- unique(sort(as.character(nodes_data_reactive()$Workstream)))
product_choices <- nodes_data_reactive() %>%
filter(Workstream == testing[i]) %>%
select(Product_name) %>%
unlist(use.names = FALSE) %>%
as.character()
product_prices <- nodes_data_reactive() %>%
filter(Workstream == testing[i]) %>%
select(Salary) %>%
unlist(use.names = FALSE)
if(!is.null(input[[paste0("all_", i)]])){
if(input[[paste0("all_", i)]] == TRUE) {
updateCheckboxGroupInput(session,
paste0("checkbox_", i),
label = NULL,
choiceNames = product_choices,
choiceValues = product_prices,
selected = product_prices)
} else {
updateCheckboxGroupInput(session,
paste0("checkbox_", i),
label = NULL,
choiceNames = product_choices,
choiceValues = product_prices,
selected = c()
)
}
}
})
})
# this code here is what i want to adapt or change
# What i want is to create two things
# one is a reactive that will update when a user selects checkboxes (but not the all checkbox)
# this will then result in the unique id values from the id column to appear
# i would also want this reactive to work in conjuction with the select all button
# so that if a user hits the button - then this reactive will populate with the rest of the unique ids
# is this possible?
# got the following code in shiny it doesnt work but i am close!
# chosen_items <- reactive({
#
# if(input$select_by == "Food"){
#
# # obtain all of the underlying price values
# unlist(lapply(1:length(unique(na.omit(nodes_data_reactive()$Food ))),
# function(i){
#
# eval(parse(text = paste("input$`", unique(na.omit(
#
# nodes_data_reactive()$Food
#
# ))[i], "`", sep = ""
#
#
# )))
#
# } # end of function
#
#
#
# )) # end of lapply and unlist
#
# }
# })
} # end of server
# Run the application
shinyApp(ui = ui, server = server)