разделить на блестящие полосы прокрутки для всего приложения

Question

Я пытаюсь использовать пакет, который позволяет пользователям отображать свои данные в блестящем ( esquiss ). Работает нормально. Однако пользовательский интерфейс для блестящего модуля в упаковке требует контейнера фиксированной высоты. Поэтому я поместил вызов модуля в тег $ div (внутри модального окна), вызываемый кнопкой.

Проблема в том, что этот вызов этого модуля, кажется, избавляет от всех полос прокрутки для главной страницы приложения (поэтому я не могу прокрутить до нижней части главной страницы (это одностраничное приложение). Как я могу ограничить HTML модуля, чтобы он не перекрывал остальную часть приложения? Код вызываемого модуля: здесь .

Вот мой воспроизводимый пример:

ui.R

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

server.R

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)