Conditionalpanel inside Info_window html content

[cwilligv]

Hi there,
I’ve set up my markers with HTML content inside the info_window parameter. I’ve implemented some interactive features and one of the component is a switch input that changes the visibility of another component in there, however, it seems to ignore the condition and doesn’t do anything. Do you know if this is by design or is there another way to enable that interactivity inside the info_window?

Cheers

[dcooley]

Do you know if this is by design

No idea I'm afraid.

Can you share an example of what you're trying to do please?

[cwilligv]

Sure, here is a reprex:

# Load packages 
library(shiny) 
library(bslib)
library(googleway)
library(shinyWidgets)
library(ShinyRating)

# Define the UI
ui <- fluidPage(
  google_mapOutput("map")
)

# Define the server
server <- function(input, output) {
  
  # Create some dummy data
  data <- data.frame(
    lat = c(-27.469),
    lon = c(153.0251),
    siq = c(85)
  )
  
  # Generate the map with markers and info windows
  output$map <- renderGoogle_map({
    google_map(key = "you-api-key") %>%
      googleway::add_markers(data = data, lat = "lat", lon = "lon", info_window = create_info_window(data))
  })
  
  create_info_window <- function(data){
    as.character(
      card(
        class = "shadow-none mx-0 px-0",
        card_body(
          gap = 0,
          padding = 0,
          min_height = 200,
          switchInput("test1", onLabel = "Street", offLabel = "Mall", value = TRUE),
          p("Score"),
          conditionalPanel(
            condition = "input.test1 == true",
            ratingInput(
              inputId = "star20x",
              i_on_color = "#D5AB55",
              cumul = TRUE,
              number = 5,
              value = 3,
              read_only = T
            )
          )
        )
      )
    )
  }
}

# Run the app
shinyApp(ui, server)

And this is sort of what I look for in the info_window:

library(shiny)
library(bslib)
library(ShinyRating)

# UI
ui <- fluidPage(
  theme = bs_theme(),
  titlePanel("Toggle Button Visibility with SwitchInput"),
  sidebarLayout(
    sidebarPanel(
      switchInput("toggle", "Show Button", value = TRUE)
    ),
    mainPanel(
      conditionalPanel(
        condition = "input.toggle == true",
        ratingInput(
          inputId = "star20x",
          i_on_color = "#D5AB55",
          cumul = TRUE,
          number = 5,
          value = 3,
          read_only = T
        )
      )
    )
  )
)

# Server
server <- function(input, output) { }

# Run the application 
shinyApp(ui = ui, server = server)

[dcooley]

where is ShinyRating hosted?

[cwilligv]

oh sorry, use this: devtools::install_github("mhanf/ShinyRating")

[dcooley]

in theory you can specify an DOM inside the info window and it will work.

Here's a minimal example, with the code taken from this SO answer

Note that the info_window parameter requires a 'string specifying the column name', so I've attached the 'info' as a column on the data object

library(shiny) 
library(googleway)

# Define the UI
ui <- fluidPage(
  google_mapOutput("map")
)

# Define the server
server <- function(input, output) {
  
  # Create some dummy data
  data <- data.frame(
    lat = c(-27.469),
    lon = c(153.0251),
    siq = c(85),
    info = paste0('<div id="content" style="width:400px; background-color:red;">',
      'My Text comes here' ,
      '</div>'
    )
  )
  
  output$map <- renderGoogle_map({
    google_map(key = secret::get_secret("GOOGLE")) %>%
      googleway::add_markers(data = data, lat = "lat", lon = "lon", info_window = "info")
  })
}

shinyApp(ui, server)

[cwilligv]

Thanks Dave. Indeed, it works the way you frame it in your example but as soon as I include the conditonalpanel, it seems like the condition can't find the input I'm referring to and doesn't do anything.

If I use your example and add the info html content as a column in the dataframe without the conditionalpanel it works

data <- data.frame(
    lat = c(-27.469),
    lon = c(153.0251),
    siq = c(85),
    info = as.character(
      tags$div(
        switchInput("test1", onLabel = "Street", offLabel = "Mall", value = TRUE),
        p("Score"),
        ratingInput(
          inputId = "star20x",
          i_on_color = "#D5AB55",
          cumul = TRUE,
          number = 5,
          value = 3,
          read_only = T
        )
      )
    )
  )

However, if I include the conditionalpanel then the rating component doesn't even show:

data <- data.frame(
    lat = c(-27.469),
    lon = c(153.0251),
    siq = c(85),
    info = as.character(
      tags$div(
        switchInput("test1", onLabel = "Street", offLabel = "Mall", value = TRUE),
        p("Score"),
        conditionalPanel(
          condition = "input.test1 == true",
          ratingInput(
            inputId = "star20x",
            i_on_color = "#D5AB55",
            cumul = TRUE,
            number = 5,
            value = 3,
            read_only = T
          )
        )
      )
    )
  )

Should the input id 'test1' be referenced in a different way perhaps, for the condition in conditionalpanel to pick it up?

[cwilligv]

After studying this more I think the issue is that when the info_window is triggered shiny doesn’t know anything about those inputs inside so they need to be binded for the conditional panel to pick it up. any ideas on how to bind those input elements in Shiny?

[cwilligv]

Hey @dcooley , I've found a similar problem happening with Leaflet in stackoverflow and it was solved by binding the inputs via javascript. All credits to the authors (K. Rohde and Dean Attali)
Now, are you able to provide an equivalent solution for google maps?

The following reprex uses leaflet's popup feature (info_window in google maps) with input elements in it. The key part is the javascript run on map rendering that binds all the inputs contained in the popups.

library(shiny) 
library(bslib)
library(leaflet)

# Define the UI
ui <- fluidPage(
  leafletOutput("map")
)

# Define the server
server <- function(input, output, session) {
  
  # Create some dummy data
  data <- data.frame(
    lat = c(-27.469),
    lon = c(153.0251),
    siq = c(85),
    info = as.character(
      tags$div(id = "content",
               radioButtons(inputId = "test1", label = "Location Type:", choices = c("Street" = "street", "Mall" = "mall"), selected = "street", inline = TRUE),
               p("Go to Score"),
               textOutput("txt"),
               conditionalPanel(
                 condition = "input.test1 == 'street' || input.test1 == null",
                 actionButton("star1", "Bttn 1")
               ),
               conditionalPanel(
                 condition = "input.test1 == 'mall'",
                 actionButton("star2", "Bttn 2")
               )
      )
    )
  )
  
  observe({
    print(paste0("check value: ", input$test1))
  })
  
  output$txt <- renderText({
    paste("You chose: ", input$test1)
  })
  
  # Generate the map with markers and info windows
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addMarkers(
        data = data,
        lat = ~lat,
        lng = ~lon,
        popup = ~info
      ) %>% 
      htmlwidgets::onRender(
        'function(el, x) {
            var target = document.querySelector(".leaflet-popup-pane");
          
            var observer = new MutationObserver(function(mutations) {
              mutations.forEach(function(mutation) {
                if(mutation.addedNodes.length > 0){
                  Shiny.bindAll(".leaflet-popup-content");
                }
                if(mutation.removedNodes.length > 0){
                  var popupNode = mutation.removedNodes[0];
          
                  var garbageCan = document.getElementById("garbage");
                  garbageCan.appendChild(popupNode);
          
                  Shiny.unbindAll("#garbage");
                  garbageCan.innerHTML = "";
                }
              }); 
            });
          
            var config = {childList: true};
          
            observer.observe(target, config);
        }')
  })
}

# Run the app
shinyApp(ui, server)