在 Shiny 模块中使用窗口大小

Question

我有几个 Shiny 应用程序可以根据窗口大小生成具有动态宽度/高度的绘图。

我的意图一直是使用navbar、navlist、tabPanel 和模块as specified here 的组合将所有应用程序组合成一个应用程序。

下面给出了一个工作示例，没有使用模块：

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) 

由于我要组合大量应用程序组件，我已将大部分代码模块化。这是我在调用维度变量时遇到问题的地方，即使我将它包装在 ns 函数中（看起来维度被忽略了）。以下是我的全部代码，未成功从上述工作应用程序转换而来。这实际上确实工作，但宽度没有正确更新：

myPlot 模块：

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 <- 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)

关于如何在模块化绘图对象中访问窗口尺寸的任何提示？谢谢！

Answer 1

问题是模块访问的输入值是命名空间的，而Shiny.onInputChange设置的输入值不是。

所以在myPlot 模块中，input$dimension 得到myPlot-dimension 但输入实际上只是dimension。

一种解决方案是使命名空间 id 可用于脚本：

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)

---

另一种带有免责声明的解决方案：危险、无证、容易滥用的功能！您实际上可以通过session$rootScope() 从模块中获取根会话。除非您真的必须这样做，否则不会推荐，但仅供参考。

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)