在 Shiny 模块中使用 Window 大小

Utilizing Window Size Within Shiny Module

我有几个 Shiny 应用程序可以根据 window 大小生成具有动态 width/height 的绘图。

我的意图一直是使用 navbarnavlisttabPanel 和模块 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])))
  })

}

服务器,UI,和 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)

关于如何访问模块化绘图对象中的 window 维度的任何提示?谢谢!

问题是模块访问的输入值是命名空间的,而 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)