Open richardangell opened 5 years ago
Tried to dynamically generate menu items (one for each variable) which worked, each one linking to the summary graph tab. However tracking which menu item is selected only works via each menu item being associated with a unique tab. Do not want to create many tabs, instead have one and update the graph for each new variable.
library(shiny)
library(shinydashboard)
calculate_summaries_button <- actionButton(
inputId = "button",
label = "Calculate variable summaries",
icon = icon("bar-chart-o")
)
ui <- dashboardPage(
dashboardHeader(
title = "Dynamic Menu"
),
dashboardSidebar(
sidebarMenuOutput(outputId = "dy_menu"),
textOutput("res"),
tags$head(tags$style(HTML(".sidebar { height: 90vh; overflow-y: auto; }")))
),
dashboardBody(
tabItems(
tabItem(
tabName = "main",
textInput(inputId = "new_menu_name",
label = "New Menu Name"),
actionButton(inputId = "add",
label = "Add Menu"),
box(
calculate_summaries_button,
width = 2,
solidHeader = TRUE,
background = "maroon",
title = "Summarise explanatory variables"
)
),
tabItem(
tabName = "summary_graphs",
h2("Summary Graphs")
)
)
)
)
server <- function(input, output, session){
observe(print(paste0("dataset: ", input$tabs)))
output$dy_menu <- renderMenu({
menu_list <- list(
menuItem("Add Menu Items", tabName = "main", selected = TRUE),
menu_vals$menu_list
)
# add the id seems to stop the dynamically generated menu items being
# selected properly - selection jumps back to first item
sidebarMenu(#id = "tabs",
.list = menu_list)
})
menu_vals = reactiveValues(menu_list = NULL)
observeEvent(
eventExpr = input$button,
handlerExpr = {
summary_results <- do.call(what = helpers::summarise_columns,
args = list(df = get("x", envir = globalenv()),
cols = colnames(get("x", envir = globalenv()))[sample(200, size = 40, replace = FALSE)],
weight = "weights",
observed = "target"))
# reset the list to just the first element the add menu items tab
menu_vals$menu_list <- list()
for (a in names(summary_results)) {
menu_vals$menu_list[[length(menu_vals$menu_list) + 1]] <-
menuItem(a, tabName = "summary_graphs")
}
}
)
output$res <- renderText({
paste(input$tabs)
})
}
shinyApp(ui, server)
Refactor code for server and ui