how to use bs_attach_modal with renderUI?

[Maxime_deb]

Hello All,

I am used to add bs_modal with a small information icon to explain properly the form of the input to the user. However, when creating an input using uiOutput and renderUI, I cannot make it work.

Does anyone have a working solution for this?
You can fin below a simple Reprex. The first numericInput has the desired bs_modal. I am trying to have the same for the second input (uiOutput).

In the example below, I did not add the code that I thought would make the bs_modal appear as the uiOutput did not show anymore when I tried.

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyBS)
library(bsplus)
library(shinyMatrix)

################ HEADER  ################
header <- dashboardHeaderPlus(title = 'Example', titleWidth=300)


################ SIDEBAR  ################
sidebar <- dashboardSidebar(
  collapsed = TRUE,
  disable = TRUE
)

################ BODY  ################

body <- dashboardBody(
  fluidPage(
    tags$style(type="text/css",
               ".shiny-output-error {visibility: hidden; }",
               ".shiny-output-error:before {visibility: hidden; }"),
    fluidRow(
      column(width=4,
             tags$head(
               tags$style(type="text/css", ".inline label{ display: table-cell; text-align: left; vertical-align: middle; }
                          .inline .form-group{display: table-row;}")),

             bs_modal(id = "Test", title = "Test", body = "This is a test!"),
             bs_modal(id = "Options", title = "Options", body = "This is some options!"),

             numericInput(inputId="test", label="Test : ", value=100, min=1, max=1000, step=1) %>%
               shinyInput_label_embed(shiny_iconlink() %>% bs_attach_modal(id_modal = 'Test')),

              uiOutput("options")
             ))
)
)

################ UI  ################
ui <- dashboardPagePlus(
  header,
  sidebar,
  sidebar_fullCollapse = TRUE,
  body
)



################ SERVER  ################
server <- function(input, output,session) {

  output$options <- renderUI({
    bs_modal(id = "Options", title = "Options", body = "Speak about options!")
    options_mat <- matrix(c(100,120,0.2,0.17), 2, 2, dimnames = list(as.character(1:2), c("Test1","Test2")))
    result <- matrixInput(inputId="options_matrix",label="Options' information : ",value = options_mat,rows = list(names = TRUE),cols = list(names = TRUE), class = "numeric")
    result
    })
}

################ SHINY APP  ################
shinyApp(ui = ui, server = server)

[gfsarmanho]

Hi, Maxime_deb!

Apparently the problem was not related to renderUI()/ uiOutput(), but with matrixInput(). It returns a list of shiny.tags (2 'head' and 1 'div' - the table itself), while bs_attach_modal()'s tag argument requires only one.

So I managed to assign the modal to the correct tag and is working now:

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyBS)
library(bsplus)
library(shinyMatrix)

################ HEADER  ################
header <- dashboardHeaderPlus(title = 'Example', titleWidth=300)

################ SIDEBAR  ################
sidebar <- dashboardSidebar(
  collapsed = TRUE,
  disable = TRUE
)

################ BODY  ################
body <- dashboardBody(
  fluidPage(
    tags$style(type="text/css",
               ".shiny-output-error {visibility: hidden; }",
               ".shiny-output-error:before {visibility: hidden; }"),
    fluidRow(
      column(width=4,
             tags$head(
               tags$style(type="text/css", ".inline label{ display: table-cell; text-align: left; vertical-align: middle; }
                          .inline .form-group{display: table-row;}")),
             
             bs_modal(id = "Test", title = "Test", body = "This is a test!"),
             numericInput(inputId="test", label="Test : ", value=100, min=1, max=1000, step=1) %>%
               shinyInput_label_embed(shiny_iconlink() %>% bs_attach_modal(id_modal = 'Test')),
             
             uiOutput(outputId = "options"),
             bs_modal(id = "options_modal", title = "Options", body = "Speak about options!")

      ))
  )
)

################ UI  ################
ui <- dashboardPagePlus(
  header,
  sidebar,
  sidebar_fullCollapse = TRUE,
  body
)

################ SERVER  ################
server <- function(input, output,session) {
  
  output$options <- renderUI({
    options_mat <- matrix(c(100,120,0.2,0.17), 2, 2, dimnames = list(as.character(1:2), c("Test1","Test2")))
    mat_input <- matrixInput(inputId = "options_matrix", label="Options' information : ",
                          value = options_mat,rows = list(names = TRUE),
                          cols = list(names = TRUE), class = "numeric")
    tagList(
      mat_input[[1]],
      mat_input[[2]],
      mat_input[[3]] %>% shinyInput_label_embed(shiny_iconlink() %>% bs_attach_modal(id_modal = 'options_modal'))
    )
  })
}

################ SHINY APP  ################
shinyApp(ui = ui, server = server)

Is it what you wanted?

[Maxime_deb]

Thank you! This is exactly what I was looking for!

May I ask you how did you go about finding this solution? I would have loved to find it by myself

Thanks again!

[gfsarmanho]

No problem

I started changing id names (to avoid duplication) and wrapping shinyInput_label_embed(shiny_iconlink() %>% ...) in your bs_attach_modal() (I used to do this way). Then, checked the HTML outputs of your matrixInput() directly on the console and got the error:

    options_mat <- matrix(c(100,120,0.2,0.17), 2, 2, dimnames = list(as.character(1:2), c("Test1","Test2")))
    mat_input <- matrixInput(
      inputId = "options_matrix", label="Options' information : ",
      value = options_mat,rows = list(names = TRUE),
      cols = list(names = TRUE), class = "numeric"
    )
    mat_input %>% shinyInput_label_embed(shiny_iconlink() %>% bs_attach_modal(id_modal = 'options_modal'))

After the error, I used class(mat_input) and understood the problem, since is a shiny.tag.list and not a tag as expected by bplus functions. I finaly used str(mat_input ) to find in which compartment the table was and modified your renderUI to return the correct tagList().

I am glad it worked!

[Maxime_deb]

Hi gfsarmanho,

Might need your insight on the following. The solution you suggested worked like a charm when running the App locally on RStudio. However, the matrix does not show when I run the app inside a docker container.

I got the following error:

"Error: class is: form-group shiny-matrix-input-container shiny-input-container, needs to be: form-group shiny-input-container"

Any idea how can I get around this?

Look forward to reading from you,

Maxime

[nirgrahamuk]

This must relate to a difference between your local environment and your docker environment.
use sessionInfo() to understand the package versions look particularly at shiny and shinyMatrix

There are tools like renv you can learn to use to track your package versions and therefore reproduce environments across platforms more painlessly.

[Maxime_deb]

Thanks, I will have a look at this and revert this week.

Regards,

Maxime