Background color of dynamic UI input element in shiny module-CodePudding

In a complex shiny app, I created shiny modules that contain an instance of shinyWidgets::autonumericInput(). Moreover, the input is implemented as dynamic UI element. I want to determine the background color by a parameter of the server function.

I accomplished styling inputs in the desired way in a simple, not modularised and not dynamic UI context, by using e.g. tags$style("#inputid{background-color: red;})"). In the more complex context, I encounter two problems:

Because it's inside a module, the ID is namespaced
because it's inside a renderUI function, it's on the server side

Here is what I tried in a simplified example:

library(shiny)
library(shinyWidgets)

selectModUI <- function(id) {
  ns <- NS(id)
  uiOutput(ns("varinput"))
}

selectModServer <- function(id, label, car, var, color) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    val <- reactive({
      mtcars[car(), var]
    })
    
    output$varinput <- renderUI({
      ns <- session$ns
      tags$style(paste0("#", ns("numinput"), "{background-color: ", color, " !important;})"))
      autonumericInput(ns("numinput"),
                       label = label,
                       value = val(),
                       align = "right")
    })
  })
}

ui <- fluidPage(

  titlePanel("A reproducible shiny app"),

  sidebarLayout(
    sidebarPanel(
      selectInput("carsel", "Select a car", choices = row.names(mtcars),
                  selected = row.names(mtcars)[1]),
      selectModUI("in1"),
      selectModUI("in2")
    ),

    mainPanel(
      h1("content goes here")
    )
  )
)

server <- function(input, output) {

  selectModServer(id = "in1",
                  label = "Horsepower",
                  car = reactive(input$carsel),
                  var = "hp",
                  color = "darkseagreen")
  selectModServer(id = "in2",
                  label = "Rear axle ratio",
                  car = reactive(input$carsel),
                  var = "drat",
                  color = "khaki")
}

shinyApp(ui = ui, server = server)

What am I doing wrong? This is how it should look like:

CodePudding user response：

All you have to do is use tagList around the style and input tags:

tagList(
        tags$style(paste0("#", ns("numinput"), "{background-color: ", color, " !important;})")),
        autonumericInput(ns("numinput"),
                         label = label,
                         value = val(),
                         align = "right")
      )

In your code, the style tag was not actually output in the uiOutput, only the autonumericinput was returned.

I tested it with this change and it works.

CodePudding user response：

You're returning only the selectInput from your module server. The tag$style goes nowhere. The solution is to wrap both in a tagList:

    output$varinput <- renderUI({
      print(color)
      ns <- session$ns
      tagList(
        tags$style(paste0("#", ns("numinput"), "{background-color: ", color, " !important;})")),
        autonumericInput(ns("numinput"),
                       label = label,
                       value = val(),
                       align = "right")
      )
    })

This passes both the style element and the selectinput to the renderUI call.

As required.