Как добавить x-scroll к разделу блестящего приложения?

Question

Следующий код должен добавить бесконечное количество столбцов, а внизу должна появиться полоса прокрутки. Но полоса прокрутки здесь не работает. Пожалуйста, помогите ..

library(shiny)

ui <- fluidPage(
  fluidRow(
   actionButton("addCol","Add New Column"),
   div(style="overflow-x: auto;",
            uiOutput("myUI")
   )
  )
)

server <- function(input, output, session) {
  alld <- reactiveValues()
  alld$ui <- list()

  observeEvent(input$addCol,{

    alld$ui[[length(alld$ui)+1]] <- verbatimTextOutput("aaa", placeholder = T)

    output$myUI <- renderUI({
      fluidRow(lapply(alld$ui,function(x){column(4,x)}))
  })})
}

shinyApp(ui, server)

Answer 1

Вы используете Bootstrap макет (fluidPage, fluidRow, column), и вся идея такого макета заключается в отзывчивости.

Страница считается шириной 12, и элементы, превышающие ее, переносятся на новые строки. Это предполагаемое поведение Bootstrap.

Одним из способов решения вашей проблемы является использование flexbox .

Решение : (Отказ от ответственности: работает только на Chrome и Firefox)

Я сделал два изменения в вашем коде:

1. Изменил column на div с помощью пользовательского класса CSS с именем custom-column.

column(4,x) до div(class = "custom-column", x)})

2. Добавлен flex-nowrap класс к fluidRow.

fluidRow(class="flex-nowrap", lapply(alld$ui,function(x){div(class = "custom-column", x)}))

С этими изменениями макет работает так, как вы и предполагали на chrome и firefox , но он не работает в IE или браузере в RStudio.

Полный код, включая классы CSS flex-nowrap и custom-column:

library(shiny)

ui <- fluidPage(
  fluidRow(
    tags$head(tags$style("
      .flex-nowrap {
        display: inline-flex;
        -webkit-flex-wrap: nowrap !important;
        -ms-flex-wrap: nowrap !important;
        flex-wrap: nowrap !important;
        flex-direction: row;
      }

      .custom-column {
        width: 200px;
        margin: 0px 10px;
      }      
      "
    )),
    actionButton("addCol","Add New Column"),
    div(style="overflow-x: auto;",
        uiOutput("myUI")
    )
  )
)

server <- function(input, output, session) {
  alld <- reactiveValues()
  alld$ui <- list()

  observeEvent(input$addCol,{

    alld$ui[[length(alld$ui)+1]] <- verbatimTextOutput("aaa", placeholder = T)

    output$myUI <- renderUI({
      fluidRow(class="flex-nowrap", lapply(alld$ui,function(x){div(class = "custom-column", x)}))
    })})
}

shinyApp(ui, server)

выход