I have built the following module to create a colourpicker widget

library(shiny)
library(glue)
library(colourpicker)
library(scales)

mod_fill_def_ui <- function(id, level, nlevel, n) {
  ns <- NS(id)
  colourInput(inputId = ns("Fill"),
              label = glue("Colour for {level}"),
              value = hue_pal()(nlevel)[n])
}

mod_fill_def_server <- function(id) {
  moduleServer(id,
               function(input, output, session) {
                 reactive(input$Fill)
               }
  )
}

As an example, here's what the basic use of the module looks like:

ui <- fluidPage(
  mainPanel(
    mod_fill_def_ui("fill_example", "Item", 5, 1), 
    verbatimTextOutput("fill_hex")
  )
)

server <- function(input, output, session) {   
  hex <- mod_fill_def_server("fill_example")
  output$fill_hex <- renderPrint(
    hex()
  )
}

shinyApp(ui, server)

Now, I would like to apply this module as many times as needed depending on a user's input. I can apply the UI portion of the module fine as needed with the code below, but I can't figure out how to apply the server section of the module to retrieve each of the HEX codes selected.

Eventually, I plan to turn this into a named vector (i.e. c("Item1" = "#HEXCODE")) so that I can then apply it to ggplot2::scale_*_manual(values = ...).

Animals <- c("Cat", "Dog", "Rabbit", "Horse")
Vehicles <- c("Car", "Motorcycle", "Truck", "Plane", "Boat")

ui <- fluidPage(
  mainPanel(
    selectInput("items", "Item to choose:", c("Animals", "Vehicles"), "Animals"),
    br(),
    uiOutput("levels_fills"),
    verbatimTextOutput("fill_hex")
  )
)

server <- function(input, output, session) {
  vec <- reactive({
    switch(input$items, Animals = Animals, Vehicles = Vehicles)
  })
  
  output$levels_fills <- renderUI(
    purrr::map2(vec(), seq_along(vec()), function(level, n) {
      mod_fill_def_ui(glue("fill_{level}"), level, length(vec()), n)
    })
  )
  
  ### How do I use `mod_fill_def_server()` iteratively to retrieve the hex codes?
}

shinyApp(ui, server)

CodePudding user response：

Here is a very hacky way to do it. If someone comes up with a better solution I'd be very happy! You basically store the unevaluated reactives returned by the module in a reactiveValues object and then evaluate every element of reactiveValues in a new reactive. You could probably also use an ordinary list instead of reactiveValues, but then you would need to use <<- to assign the values inside the observeEvent which can lead to problems.

server <- function(input, output, session) {
  mod_results <- reactiveValues()
  vec <- reactive({
    switch(input$items, Animals = Animals, Vehicles = Vehicles)
  })
  
  output$levels_fills <- renderUI(
    purrr::map2(vec(), seq_along(vec()), function(level, n) {
      mod_fill_def_ui(glue("fill_{level}"), level, length(vec()), n)
    })
  )
  
  ### How do I use `mod_fill_def_server()` iteratively to retrieve the hex codes?
  observeEvent(vec(), {
    purrr::map(vec(), function(level) {
      mod_results[[glue("fill_{level}")]] <- mod_fill_def_server(id = glue("fill_{level}"))
    })
  })
  
  hex <- reactive({
    lapply(reactiveValuesToList(mod_results), function(current_module_output) {
      current_module_output()
    })
  })
  
  output$fill_hex <- renderPrint({
    hex()
  })
}

However, if your module only contains the colourInput, you don't need a module but could use the colourInput directly:

server <- function(input, output, session) {
  vec <- reactive({
    switch(input$items, Animals = Animals, Vehicles = Vehicles)
  })
  
  output$levels_fills <- renderUI(
    purrr::map2(vec(), seq_along(vec()), function(level, n) {
      colourInput(inputId = glue("fill_{level}"),
                  label = glue("Colour for {level}"),
                  value = hue_pal()(length(vec()))[n])
    })
  )
  
  hex <- reactive({
    purrr::map(vec(), function(level) {
      input[[glue("fill_{level}")]]
    })
  })
  
  output$fill_hex <- renderPrint({
    hex()
  })
}