Utilizing Window Size Within Shiny Module

Question

I have several Shiny apps that generate plots with dynamic width/height based on the window size.

My intention has always been to combine all the apps into one app using a combination of navbar, navlist, tabPanel, and modules as specified here.

A working example is given below, without utilizing modules:

library(shiny)
library(plotly)

# ui.R file below
ui <- shinyUI(fluidPage(

  tags$head(tags$script('
      var dimension = [0, 0];
      $(document).on("shiny:connected", function(e) {
      dimension[0] = window.innerWidth;
      dimension[1] = window.innerHeight;
      Shiny.onInputChange("dimension", dimension);
      });
      $(window).resize(function(e) {
      dimension[0] = window.innerWidth;
      dimension[1] = window.innerHeight;
      Shiny.onInputChange("dimension", dimension);
      });
      ')),

  navlistPanel(        
    tabPanel("Dynamic Dimensions",
             plotlyOutput("myPlot")
    )
  )
)
) 


# server.R file below 
server <- function(input, output) {

  output$myPlot <- renderPlotly({
    plot_ly(midwest, x = ~percollege, color = ~state, type = "scatter",
            width = (0.6 * as.numeric(input$dimension[1])), 
            height = (0.75 * as.numeric(input$dimension[2])))
  })

}


# Typically I replace below with run.R file and launch the app in browser
shinyApp(ui = ui, server = server) 

Due to the large number of app components I'm combining, I've modularized most of my code. This is where I'm having trouble calling the dimensions variable, even when I wrap it in the ns function (it appears the dimension is being ignored). Below is the entirety of my code, unsuccessfully converted from the above working app. This actually does work, but the width is not correctly updated:

myPlot modules:

myPlotUI <- function(id, label = "My Plot"){


  ns <- NS(id)


  tags$head(tags$script("
                        var dimension = [0, 0];
                        $(document).on('shiny:connected', function(e) {
                        dimension[0] = window.innerWidth;
                        dimension[1] = window.innerHeight;
                        Shiny.onInputChange('dimension', dimension);
                        });
                        $(window).resize(function(e) {
                        dimension[0] = window.innerWidth;
                        dimension[1] = window.innerHeight;
                        Shiny.onInputChange('dimension', dimension);
                        });
                        "))

  tagList(
             plotlyOutput(ns("myPlot"))
  )

} 




myPlot <- function(input, output, session){
  ns <- session$ns

  output$myPlot <- renderPlotly({
    plot_ly(midwest, x = ~percollege, color = ~state, type = "scatter",
            width = (0.6 * as.numeric(input$dimension[1])), 
            height = (0.75 * as.numeric(input$dimension[2])))
  })

}

Server, UI, and shinyApp:

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

# ui.R file below 
ui <- shinyUI(fluidPage(

# I've tried putting the js code in this section of the UI. Didn't work...

  navlistPanel(

    tabPanel("Dynamic Dimensions",
             myPlotUI("myPlot")
    )
  )
)
) 

shinyApp(ui = ui, server = server)

Any tips on how I can access the window dimensions within a modularized plot object? Thanks!

Answer 1

The issue is that input values accessed by modules are namespaced, while the input values set by Shiny.onInputChange are not.

So in the myPlot module, input$dimension gets myPlot-dimension but the input is actually just dimension.

One solution would be to make the namespaced id available to the script:

library(shiny)
library(plotly)

myPlotUI <- function(id, label = "My Plot") {
  ns <- NS(id)
  dimensionId <- ns("dimension")

  tagList(
    tags$head(tags$script(sprintf("
      var dimensionId = '%s';
      var dimension = [0, 0];

      $(document).on('shiny:connected', function(e) {
        dimension[0] = window.innerWidth;
        dimension[1] = window.innerHeight;
        Shiny.onInputChange(dimensionId, dimension);
      });

      $(window).resize(function(e) {
        dimension[0] = window.innerWidth;
        dimension[1] = window.innerHeight;
        Shiny.onInputChange(dimensionId, dimension);
      });
    ", dimensionId))),

    plotlyOutput(ns("myPlot"))
  )
}

myPlot <- function(input, output, session) {
  ns <- session$ns

  output$myPlot <- renderPlotly({
    plot_ly(midwest, x = ~percollege, color = ~state, type = "scatter",
            width = (0.6 * as.numeric(input$dimension[1])),
            height = (0.75 * as.numeric(input$dimension[2])))
  })

}

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

ui <- fluidPage(
  navlistPanel(
    tabPanel("Dynamic Dimensions",
             myPlotUI("myPlot"))
  )
)

shinyApp(ui = ui, server = server)

---

Another solution that comes with a disclaimer: DANGER, undocumented, abuse-prone feature! You can actually get the root session from a module through session$rootScope(). Would not recommend unless you really have to, but just FYI.

library(shiny)
library(plotly)

myPlotUI <- function(id, label = "My Plot") {
  ns <- NS(id)

  tagList(
    tags$head(tags$script("
      var dimension = [0, 0];

      $(document).on('shiny:connected', function(e) {
        dimension[0] = window.innerWidth;
        dimension[1] = window.innerHeight;
        Shiny.onInputChange('dimension', dimension);
      });

      $(window).resize(function(e) {
        dimension[0] = window.innerWidth;
        dimension[1] = window.innerHeight;
        Shiny.onInputChange('dimension', dimension);
      });
  ")),

    plotlyOutput(ns("myPlot"))
  )
}

myPlot <- function(input, output, session) {
  ns <- session$ns
  rootInput <- session$rootScope()$input

  output$myPlot <- renderPlotly({
    plot_ly(midwest, x = ~percollege, color = ~state, type = "scatter",
            width = (0.6 * as.numeric(rootInput$dimension[1])),
            height = (0.75 * as.numeric(rootInput$dimension[2])))
  })

}

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

ui <- fluidPage(
  navlistPanel(
    tabPanel("Dynamic Dimensions",
             myPlotUI("myPlot"))
  )
)

shinyApp(ui = ui, server = server)