richardangell / ladybird-umbrella

Tool to visualise datasets used in modelling
MIT License
0 stars 1 forks source link

Refactor code #42

Open richardangell opened 5 years ago

richardangell commented 5 years ago

Refactor code for server and ui

richardangell commented 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)