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

}

服务器，用户界面和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)

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

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()从模块获取根会话。除非你真的需要，否则不建议，但仅限于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)

利用闪亮模块中的窗口大小

1 个答案: