基于窗口大小的闪亮动态内容(如 css 媒体查询) [英] Shiny dynamic content based on window size (like css media query)

问题描述

我在面板中有一些图.当窗口宽度较小时，我想将它们更改为 tabsetpanel.有什么方法可以确定浏览器的窗口宽度.例如，在下面的示例中，当窗口宽度足够大时，如何将 uiOutput 从 plotPanel1 切换到 plotPanel2.

I have some plots in a panel. I want to change them into tabsetpanel when the window width is small. Is there any way in shiny to determine window width of browser. For example, in the following example, how can I switch uiOutput from plotPanel1 to plotPanel2 when the window width is large enough.

library(ggplot2)

ui <- fluidPage(
  title = "TestApp",
  h1("Test Application"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins", "Bins", 2, 20, 1, value = 10)
    ),
    mainPanel(
      fluidRow(
        uiOutput("plotPanel1")
      )
    )
  )
)
server <- function(input, output, session){
  output$plot1 <- renderPlot({
    mdl <- lm(mpg ~ ., data = mtcars)
    ggplot(mdl, aes(.resid)) + geom_histogram(bins = input$bins)
  }, res = 110)
  output$plot2 <- renderPlot({
    mdl <- lm(UrbanPop ~ ., data = USArrests)
    ggplot(mdl, aes(.resid)) + geom_histogram(bins = input$bins)
  }, res = 110)
  output$plot3 <- renderPlot({
    mdl <- lm(uptake ~ ., data = CO2)
    ggplot(mdl, aes(.resid)) + geom_histogram(bins = input$bins)
  }, res = 110)
  output$plotPanel1 <- renderUI({
    tabsetPanel(
      tabPanel(
        "plot1",
        plotOutput("plot1")
      ),
      tabPanel(
        "plot2",
        plotOutput("plot2")
      ),
      tabPanel(
        "plot3",
        plotOutput("plot3")
      )
    )
  })
  output$plotPanel2 <- renderUI({
    fluidRow(
      column(
        4,
        plotOutput("plot1")
      ),
      column(
        4,
        plotOutput("plot2")
      ),
      column(
        4,
        plotOutput("plot3")
      )
    )
  })
}

runApp(shinyApp(ui, server))

推荐答案

由于 Shiny 正在生成一堆 HTML，您可以使用 media-query，或者另一种可能性是使用 javaScript 并获取窗口的宽度.我在使用 css 解决方案时遇到了一些问题，但我将向您展示两者:

Since Shiny is generating a bunch of HTML you could use media-query, or another possibility is to use javaScript and get the width of the window. I had some trouble with the css solution, but I will show you both:

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

With javaScript you can define an input element based on the width of the window:

  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 主题 用于 JS 代码.)

If this script is included in the UI, you can then access input$width to obtain the width of the window. (Disclaimer: I used the accepted answer in the following SO topic for the JS code.)

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

I added an observer to check the width. If it is below/above a certain threshold then the elements are shown/hidden.

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

在我看来，这不是一个完美的解决方案，因为我们对每个绘图都进行了两次渲染，但是您可能可以以此为基础.

This is not a perfect solution in my opinion, since we are rendering every plot twice, however you can probably build on this.

您可以在 tags$head 中的 media-query 中控制 display 属性.它适用于任何元素，但我发现它不适用于 UIOutput.

You can control the display attribute within a media-query in tags$head. It works fine for any element, however I found that it doesn't work well with UIOutput.

带有 text 的简单 div 的工作示例:

Working example for simple div with 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 的不工作示例:

ui <- fluidPage(
  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$style(HTML("
      @media screen and (min-width: 1000px) {
        #plotPanel1 {
          display: none;
        }

        #plotPanel2 {
          display: block;
        }
      }

      @media screen and (max-width: 1000px) {
        #plotPanel1 {
          display: block;
        }

        #plotPanel2 {
          display: none;
        }
      }
      "
    ))
    )
)
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())
        )
      ) 
    )
  })
}

runApp(shinyApp(ui, server))

这篇关于基于窗口大小的闪亮动态内容(如 css 媒体查询)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！