Question

我在面板中有一些情节。当窗口宽度很小时，我想将它们更改为self.session.sessionPreset = .medium。是否有任何方法可以确定浏览器的窗口宽度。例如，在以下示例中，当窗口宽度足够大时，如何将tabsetpanel从uiOutput切换到plotPanel1。

plotPanel2

Answer 1

由于Shiny生成一堆HTML，您可以使用media-query，或者另一种可能性是使用javaScript并获取窗口的宽度。 css解决方案遇到了一些麻烦，但我会告诉你们两个：

方法＃1（工作）：使用javaScript

使用javaScript，您可以根据窗口的width定义输入元素：

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

如果此脚本包含在UI中，您可以访问input$width以获取窗口的宽度。（免责声明：我在以下SO topic中使用了接受的答案作为JS代码。）

我添加了observer来检查宽度。如果它低于/高于某个阈值，则显示/隐藏元素。

  observe( {
    req(input$width)
    if(input$width < 800) {
      shinyjs::show("plotPanel1")
      shinyjs::hide("plotPanel2")
    } else {
      shinyjs::hide("plotPanel1")
      shinyjs::show("plotPanel2")
    }
  })

完整代码：

library(shinyjs)
library(ggplot2)

ui <- fluidPage(
  useShinyjs(),
  title = "TestApp",
  h1("Test Application"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins", "Bins", 2, 20, 1, value = 10)
    ),
    mainPanel(
      fluidRow(
        div(id="p1", uiOutput("plotPanel1")),
        div(id="p2", uiOutput("plotPanel2"))
      )
    )
  ),
  tags$head(tags$script('
                        var width = 0;
                        $(document).on("shiny:connected", function(e) {
                          width = window.innerWidth;
                          Shiny.onInputChange("width", width);
                        });
                        $(window).resize(function(e) {
                          width = window.innerWidth;
                          Shiny.onInputChange("width", width);
                        });
                        '))
)

server <- function(input, output, session){
  plot1 <- reactive({
    ggplot(lm(mpg ~ ., data = mtcars), aes(.resid)) +
      geom_histogram(bins = input$bins)
  }) 
  plot2 <- reactive({
    ggplot(lm(UrbanPop ~ ., data = USArrests), aes(.resid)) +
      geom_histogram(bins = input$bins)
  }) 
  plot3 <- reactive({
    ggplot(lm(uptake ~ ., data = CO2), aes(.resid)) +
      geom_histogram(bins = input$bins)
  })

  output$plotPanel1 <- renderUI({
    tagList(
      tabsetPanel(
        tabPanel(
          "plot1",
          renderPlot(plot1())
        ),
        tabPanel(
          "plot2",
          renderPlot(plot2())
        ),
        tabPanel(
          "plot3",
          renderPlot(plot3())
        )
      )
    )
  })

  output$plotPanel2 <- renderUI({
    tagList(
      fluidRow(
        column(
          4,
          renderPlot(plot1())
        ),
        column(
          4,
          renderPlot(plot2())
        ),
        column(
          4,
          renderPlot(plot3())
        )
      ) 
    )  
  })

  observe( {
    req(input$width)
    if(input$width < 800) {
      shinyjs::show("plotPanel1")
      shinyjs::hide("plotPanel2")
    } else {
      shinyjs::hide("plotPanel1")
      shinyjs::show("plotPanel2")
    }
  })
}

runApp(shinyApp(ui, server))

在我看来，这不是一个完美的解决方案，因为我们每次都会渲染两次，但是你可以在此基础上进行构建。

方法＃2（不工作）：CSS和媒体查询

您可以在display的{{1}}内控制media-query属性。它适用于任何元素，但我发现它与tags$head不兼容。

带UIOutput的简单div的工作示例：

text

不适用ui <- fluidPage( tags$head( tags$style(HTML(" @media screen and (min-width: 1000px) { #p1 { display: none; } #p2 { display: block; } } @media screen and (max-width: 1000px) { #p1 { display: block; } #p2 { display: none; } } " )) ), div(id="p1", "First element"), div(id="p2", "Second element") )的示例：

UIOutput

基于窗口大小的闪亮动态内容（如css媒体查询）

1 个答案:

方法＃1（工作）：使用javaScript

方法＃2（不工作）：CSS和媒体查询