div用于整个应用程序的闪亮的覆盖滚动条

Question

我正在尝试使用一个包，该包允许用户以闪亮的形式显示其数据（esquiss）。工作正常。但是，包装中发光模块的用户界面需要固定高度的容器。因此，我将对模块的调用放置在由按钮调用的tag $ div（在模式内）中。

问题在于，对此模块的调用似乎摆脱了应用程序主页的所有滚动条（因此我无法滚动到主页底部（这是一页应用程序）。限制模块的html以防止其覆盖应用程序的其余部分？被调用模块的代码在此处。

我的可重现示例如下：

用户界面

library(shiny)
library(esquisse)
library(shinyBS)

ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title = ''),
    dashboardSidebar(
      sidebarMenu(
        menuItem("Dashboard")
      )),

  dashboardBody(   
      actionButton(inputId = "esquissGraphs",label = "esquissGraphs"),
      DT::dataTableOutput("mytable"),
      bsModal("modalExample", "Data Table", "esquissGraphs", size = "large",

  tags$h1("Use esquisse as a Shiny module"),
  radioButtons(
    inputId = "data",
    label = "Data to use:",
    choices = c("Mydftbbinnit", "mtcars"),
    inline = TRUE
  ),
  tags$div(
    style = "height: 700px;", # needs to be in fixed height container
    esquisserUI(
      id = "esquisse",
      header = FALSE, # dont display gadget title
      choose_data = FALSE # dont display button to change data
    )
  )
    )
)
)
)

服务器

RV <- reactiveValues(data = data.frame())
RV2 <- reactiveValues(data = data.frame())

server <- function(input, output, session) {

n<-c("1","434","101")
t<-c("Bugs","Mugs","Thugs")
RV$data<-data.frame(n,t,stringsAsFactors = FALSE)  

o<-c("1","434","101")
p<-c("Bugs","Mugs","Thugs")
RV2$data<-data.frame(o,p,stringsAsFactors = FALSE)  

output$mytable = DT::renderDataTable({
  mtcars
})


data_r <-reactiveValues(data = data.frame())
observeEvent(input$data, {
    if (input$data == "Mydftbbinnit") {
      data_r$data <- RV$data
      data_r$name <- "Mydftbbinnit"
    } else {
      data_r$data <- RV2$data
      data_r$name <- "The rest"
    }
  })
callModule(module = esquisserServer, id = "esquisse", data = data_r)
}
shinyApp(ui, server)

Answer 1

您需要添加

tags$style("html, body {overflow: visible !important;")

在用户界面中强制显示滚动条。

来源：https : //github.com/dreamRs/esquisse/blob/master/R/esquisserUI.R

完整示例给出：

library(shiny)
library(shinydashboard)
library(esquisse)
library(shinyBS)
library(shiny)
library(esquisse)
library(shinyBS)

ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title = ""),
    dashboardSidebar(
      sidebarMenu(
        menuItem("Dashboard")
      )
    ),

    dashboardBody(
      tags$style("html, body {overflow: visible !important;"),
      actionButton(inputId = "esquissGraphs", label = "esquissGraphs"),
      DT::dataTableOutput("mytable"),
      bsModal("modalExample", "Data Table", "esquissGraphs",
        size = "large",

        tags$h1("Use esquisse as a Shiny module"),
        radioButtons(
          inputId = "data",
          label = "Data to use:",
          choices = c("Mydftbbinnit", "mtcars"),
          inline = TRUE
        ),
        tags$div(
          style = "height: 700px;", # needs to be in fixed height container
          esquisserUI(
            id = "esquisse",
            header = FALSE, # dont display gadget title
            choose_data = FALSE # dont display button to change data
          )
        )
      )
    )
  )
)

RV <- reactiveValues(data = data.frame())
RV2 <- reactiveValues(data = data.frame())

server <- function(input, output, session) {
  n <- c("1", "434", "101")
  t <- c("Bugs", "Mugs", "Thugs")
  RV$data <- data.frame(n, t, stringsAsFactors = FALSE)

  o <- c("1", "434", "101")
  p <- c("Bugs", "Mugs", "Thugs")
  RV2$data <- data.frame(o, p, stringsAsFactors = FALSE)

  output$mytable <- DT::renderDataTable({
    mtcars
  })


  data_r <- reactiveValues(data = data.frame())
  observeEvent(input$data, {
    if (input$data == "Mydftbbinnit") {
      data_r$data <- RV$data
      data_r$name <- "Mydftbbinnit"
    } else {
      data_r$data <- RV2$data
      data_r$name <- "The rest"
    }
  })
  callModule(module = esquisserServer, id = "esquisse", data = data_r)
}
shinyApp(ui, server)