模块内闪亮盒子的高度

Question

我想根据用户窗口的大小来调整事物的大小。

我发现了这个问题。我确实成功地修改了 GyD 的优秀答案，使其能够与模块一起使用，请参阅下面的代码。 不幸的是，我需要保留

tags$head(tags$script(scr))

位作为调用

dashboardBody()

的参数。我很高兴这能起作用；但我不太高兴我指的是它们所在模块之外的标签。这违背了使用模块的目的。

有什么方法可以将调整大小脚本移动到

modTestUI

，以便我在每次调用 modTestUI 时控制

"{tabName}-container"

的高度？

library(shiny)
library(shinydashboard)
library(glue)



modTestUI <- function(tabName) {
  tabItem(
    tabName = tabName,
    fluidRow(
      box(id = NS(tabName,"container"),
          #stuff goes here
      )
    )
  )
}

scr <- '
      // Define function to set height of "container"
      setHeight = function() {
        var window_height = $(window).height();
        var header_height = $(".main-header").height();

        var boxHeight = window_height - header_height - 90;
        '
tabs <- list("test1", "test2")
tabs <- glue('$("#{tabs}-container").height(boxHeight);')        
tabs <- paste0(tabs, collapse = "")

scr <- paste0(scr, tabs, '};

      // Set input$box_height when the connection is established
      $(document).on("shiny:connected", function(event) {
        setHeight();
      });

      // Refresh the box height on every window resize event    
      $(window).on("resize", function(){
        setHeight();
      });
    ')

ui <- dashboardPage(
  dashboardHeader(title = "Menu"),
  dashboardSidebar(
    sidebarMenu(
      id = "tabs",
      menuItem("Menu"),
      menuSubItem("Test 1", tabName = "test1"),
      menuSubItem("Test 2", tabName = "test2")
    )
  ),
  dashboardBody(
    tags$head(tags$script(scr)),
    tabItems(
      modTestUI("test1"),
      modTestUI("test2")
    
    )
  )
)

server <- function(input, output) {
  #stuff goes here
}

shinyApp(ui, server)

Answer 1

所以，我可能觉得回答自己的问题有点傻。但是，我周末读了很多书，并找到了解决方案。它可能对其他人有价值。

解决方案是使用 CSS 类选择器。并使用 htmltools 将类添加到您想要调整大小的任何内容。

htmltools::tagQuery(
          box(
            id = NS(tabName,"container"),
            plotlyOutput(NS(tabName,"plot"), height = '100%')
          )
        )$find(".box-body")$addClass("full-tabheight")$allTags()

然后我们可以在脚本中通过

$(".full-tabheight").height(boxHeight);

引用这个。

所以：以下内容对我有用。我添加了一些绘图对象只是为了好玩和演示，并且我在一个选项卡中调整了框的大小，但不在另一个选项卡中调整了框的大小：

library(shiny)
library(shinydashboard)
library(htmltools)
library(plotly)


modTestUI <- function(tabName, resize) {
  tabItem(
    tabName = tabName,
    fluidRow(
      if (resize) {
        tagQuery(
          box(
            id = NS(tabName,"container"),
            plotlyOutput(NS(tabName,"plot"), height = '100%')
          )
        )$find(".box-body")$addClass("full-tabheight")$allTags()
      }
      else {
        box(
          id = NS(tabName,"container"),
          plotlyOutput(NS(tabName,"plot"), height = '100%')
        )
      }
    )
  )
}

modTestServer <- function(tabName,df) {
  moduleServer(tabName, function(input,output,session) {
    output$plot <- renderPlotly({
      plot_ly(
        df,
        x = ~x,
        y = ~y
      )
    })
  })
}

scr <- '
      // Define function to set height of "container"
      setHeight = function() {
        var window_height = $(window).height();
        var header_height = $(".main-header").height();

        var boxHeight = window_height - header_height - 50;
        $(".full-tabheight").height(boxHeight);
      };

      // Set input$box_height when the connection is established
      $(document).on("shiny:connected", function(event) {
        setHeight();
      });

      // Refresh the box height on every window resize event    
      $(window).on("resize", function(){
        setHeight();
      });
    '

ui <- dashboardPage(
  dashboardHeader(title = "Menu"),
  dashboardSidebar(
    sidebarMenu(
      id = "tabs",
      menuItem("Menu"),
      menuSubItem("Test 1", tabName = "test1"),
      menuSubItem("Test 2", tabName = "test2")
    )
  ),
  dashboardBody(
    tags$head(tags$script(scr)),
    tabItems(
      modTestUI("test1", TRUE),
      modTestUI("test2", FALSE)
    
    )
  )
)

server <- function(input, output, session) {
  df1 <- data.frame(x = seq(3), y = seq(3)*2)
  df2 <- data.frame(x = seq(3)*3, y = seq(3)*4)
  modTestServer("test1",df1)
  modTestServer("test2",df2)
}

shinyApp(ui, server)