Passing module namespace to embedded javascript function

[rpodcast]

I've been working on a custom Shiny app that renders an SVG image with the capability of clicking the image and having a custom Shiny input created with the "name" of the region clicked. I have a simple reprex demonstrating the functionality at this gist and it can be run in your R session with shiny::runGist('6c33ee09a16d55569c562f7aa3951088'). It's mostly working well, but I ended up "hard-coding" the module namespace ("mod1") in the call to shiny.onInputChange() within the javascript snippet:

<script type="text/JavaScript">
  <![CDATA[
         function showRegionID(param) {
            Shiny.onInputChange("mod1-region_clicked", param);
            console.log("registered click");
            //alert("region ID is: "+ param);
         }
      ]]>
    </script>

Ideally I want to supply an additional parameter to showRegionID with the namespace used in the module itself, but I couldn't find an intuitive way to handle it. Has anyone tried this before? Complete app code below:

app code

library(shiny)
library(xml2)

mod_image_ui <- function(id) {
  ns <- NS(id)
  tagList(
    fluidRow(
      column(
        width = 6,
        htmlOutput(ns("image_render"))
      ),
      column(
        width = 6,
        verbatimTextOutput(ns("debugging"))
      )
    )
  )
}

mod_image_server <- function(input, output, session) {
  output$image_render <- renderUI({
    includeHTML("www/image.svg")
  })
  
  output$debugging <- renderPrint({
    ns <- session$ns
    input[['region_clicked']]
  })
}

ui <- fluidPage(
  mod_image_ui("mod1")
)

server <- function(input, output, session) {
  callModule(mod_image_server, "mod1")
}

shinyApp(ui, server)

svg file code

<svg 
  width="480" 
  height="320" 
  viewBox="0 0 600 400" 
  version="1.1" 
  xmlns="http://www.w3.org/2000/svg" 
  xmlns:xlink="http://www.w3.org/1999/xlink">
  <script type="text/JavaScript">
  <![CDATA[
         function showRegionID(param) {
            Shiny.onInputChange("mod1-region_clicked", param);
            console.log("registered click");
            //alert("region ID is: "+ param);
         }
      ]]>
    </script>
    <title>Amethyst</title>
    <defs>
        <linearGradient x1="29.268114%" y1="15.2524038%" x2="70.8889394%" y2="74.6384215%" id="linearGradient-1">
            <stop stop-color="#D123C2" offset="0%"></stop>
            <stop stop-color="#640CB2" offset="100%"></stop>
        </linearGradient>
    </defs>
    <a xlink:href="#" onClick="showRegionID('my_id')" cursor="pointer" pointer-events="all">
  <path d="M109.703125,155 L255.71875,310.859375 L185.40625,155 L109.703125,155 Z M300.015625,335.9375 L381.8125,155 L218.21875,155 L300.015625,335.9375 Z M186.109375,125 L233.921875,35 L172.515625,35 L105.015625,125 L186.109375,125 Z M344.3125,310.859375 L490.328125,155 L414.625,155 L344.3125,310.859375 Z M220.09375,125 L379.9375,125 L332.125,35 L267.90625,35 L220.09375,125 Z M413.921875,125 L495.015625,125 L427.515625,35 L366.109375,35 L413.921875,125 Z M446.96875,11.09375 L536.96875,131.09375 C539.156261,133.906264 540.171876,137.148419 540.015625,140.820313 C539.859374,144.492206 538.531263,147.656237 536.03125,150.3125 L311.03125,390.3125 C308.218736,393.437516 304.546898,395 300.015625,395 C295.484353,395 291.812514,393.437516 289,390.3125 L64.0000003,150.3125 C61.4999878,147.656237 60.1718761,144.492206 60.0156253,140.820313 C59.8593745,137.148419 60.8749893,133.906264 63.0625003,131.09375 L153.0625,11.09375 C155.875014,7.03122969 159.859349,5 165.015625,5 L435.015625,5 C440.171901,5 444.156236,7.03122969 446.96875,11.09375 Z" id="amethyst" fill="url(#linearGradient-1)" />
  <rect x="0" y="0" width="100%" height="100%" fill="none" />
  </a>
</svg>

[greg]

Most solutions I've seen pass the namespaced ID via inline script tag. If your function is short, you could inline the whole thing with the ID embedded:

mod_image_ui <- function(id) {
  ns <- NS(id)
  tagList(
    tags$script(HTML(sprintf('
      function showRegionID(param) {
        Shiny.onInputChange("%s", param);
        console.log("registered click");
      }
    ', ns("region_clicked")))),
    fluidRow(
      column(
        width = 6,
        htmlOutput(ns("image_render"))
      ),
      column(
        width = 6,
        verbatimTextOutput(ns("debugging"))
      )
    )
  )
}

If the function's more complicated, or if writing Javascript in R feels icky, you could inject the namespaced ID into the svg/html through a template.

Here I've added an additional input ID parameter to showRegionID, as well as a %%IMAGE_ID%% template string to be subbed out later:

<svg
  width="480"
  height="320"
  viewBox="0 0 600 400"
  version="1.1"
  xmlns="http://www.w3.org/2000/svg"
  xmlns:xlink="http://www.w3.org/1999/xlink">
  <script type="text/JavaScript">
  <![CDATA[
         function showRegionID(id, param) {
            Shiny.onInputChange(id, param);
            console.log("registered click");
            //alert("region ID is: "+ param);
         }
      ]]>
    </script>
    <title>Amethyst</title>
    <defs>
        <linearGradient x1="29.268114%" y1="15.2524038%" x2="70.8889394%" y2="74.6384215%" id="linearGradient-1">
            <stop stop-color="#D123C2" offset="0%"></stop>
            <stop stop-color="#640CB2" offset="100%"></stop>
        </linearGradient>
    </defs>
    <a xlink:href="#" onClick="showRegionID('%%IMAGE_ID%%', 'my_id')" cursor="pointer" pointer-events="all">
  <path d="M109.703125,155 L255.71875,310.859375 L185.40625,155 L109.703125,155 Z M300.015625,335.9375 L381.8125,155 L218.21875,155 L300.015625,335.9375 Z M186.109375,125 L233.921875,35 L172.515625,35 L105.015625,125 L186.109375,125 Z M344.3125,310.859375 L490.328125,155 L414.625,155 L344.3125,310.859375 Z M220.09375,125 L379.9375,125 L332.125,35 L267.90625,35 L220.09375,125 Z M413.921875,125 L495.015625,125 L427.515625,35 L366.109375,35 L413.921875,125 Z M446.96875,11.09375 L536.96875,131.09375 C539.156261,133.906264 540.171876,137.148419 540.015625,140.820313 C539.859374,144.492206 538.531263,147.656237 536.03125,150.3125 L311.03125,390.3125 C308.218736,393.437516 304.546898,395 300.015625,395 C295.484353,395 291.812514,393.437516 289,390.3125 L64.0000003,150.3125 C61.4999878,147.656237 60.1718761,144.492206 60.0156253,140.820313 C59.8593745,137.148419 60.8749893,133.906264 63.0625003,131.09375 L153.0625,11.09375 C155.875014,7.03122969 159.859349,5 165.015625,5 L435.015625,5 C440.171901,5 444.156236,7.03122969 446.96875,11.09375 Z" id="amethyst" fill="url(#linearGradient-1)" />
  <rect x="0" y="0" width="100%" height="100%" fill="none" />
  </a>
</svg>

In the app code, we can use the template to generate an svg with the namespaced ID encoded:

library(shiny)
library(xml2)

image <- function(file, id) {
  svg <- readChar(file, file.info(file)$size)
  HTML(gsub("%%IMAGE_ID%%", id, svg))
}

mod_image_ui <- function(id) {
  ns <- NS(id)
  tagList(
    fluidRow(
      column(
        width = 6,
        htmlOutput(ns("image_render"))
      ),
      column(
        width = 6,
        verbatimTextOutput(ns("debugging"))
      )
    )
  )
}

mod_image_server <- function(input, output, session) {
  output$image_render <- renderUI({
    ns <- session$ns
    image("www/image.svg", ns("region_clicked"))
  })

  output$debugging <- renderPrint({
    ns <- session$ns
    input[['region_clicked']]
  })
}

ui <- fluidPage(
  mod_image_ui("mod1"),
  mod_image_ui("mod2")
)

server <- function(input, output, session) {
  callModule(mod_image_server, "mod1")
  callModule(mod_image_server, "mod2")
}

shinyApp(ui, server)

A good thing about this approach is that it also supports multiple module instances. Still not super nice, but at least more flexible than hardcoding namespaced IDs.

[rpodcast]

Thanks so much @greg! I definitely prefer the second approach, and it is quite similar to a method I use for dynamically inserting key parameter values in a template R script launched on HPC clusters.