R shiny DT Package обрабатывает сообщение и предотвращает загрузку заголовка столбца - PullRequest
0 голосов
/ 14 июля 2020

Я использую shiny для визуализации очень большой таблицы с использованием пакета DT.

Подумайте об этом простом фрагменте кода:

library(shiny)
library(DT)

ui <- fluidPage(
  DT::dataTableOutput('mytable')
  )

server <- function(input, output, session) {
  output$mytable <- DT::renderDataTable({
    df <- data.frame(
      x = 1:10000000, y = sample(letters, 10000000, replace = TRUE),
      stringsAsFactors = FALSE
      )
    df %>%
      datatable()
  })
}

shinyApp(ui = ui, server = server)

Я хочу получить одно из две вещи:

  1. Сервер не отображает НИЧЕГО, пока вся таблица не будет готова для рендеринга (то есть не сидеть там с присутствующим заголовком столбца и сообщением `` обработка '', встроенным в этот беспорядок / беспорядок .

  2. Сервер для начала рендеринга, но сообщение «обработка» должно быть видно в чистом, отцентрованном, изолированном пространстве пользовательского интерфейса.

Я предпочитаю вариант №1 с пакетом shinycssloaders и его параметр withSpinner на стороне пользовательского интерфейса. Но, конечно, я буду в равной степени доволен решением №2.

1 Ответ

1 голос
/ 14 июля 2020

Вы можете сделать что-то вроде этого:

library(shiny)
library(DT)

css <- "
#busy { 
  position: absolute;
  z-index: 1000;
  top: 50%;
  left: 50%;
  margin-top: -200px;
  margin-left: -200px;
  display: none;
  background-color: rgba(230,230,230,.8);
  text-align: center;
  padding-top: 20px;
  padding-left: 30px;
  padding-bottom: 40px;
  padding-right: 30px;
  border-radius: 5px;
}"

js <- "
$(document).on('preInit.dt', function(e, settings){
  $('#busy').show();
});
"

initComplete <- JS(
  "function(settings, json){",
  "  $('#busy').hide();",
  "}"
)

ui <- fluidPage(
  
  tags$head(
    tags$style(HTML(css)),
    tags$script(HTML(js))
  ),
  
  tags$div(
    id = "busy", 
    tags$img(
      src = "http://cdn.lowgif.com/full/111c23b7d2d13458-loading-bar-animated-gif-transparent-background-6-gif-images-download.gif",
      width = "400"
    )
  ),
  
  DTOutput("mytable")
  
) 

server <- function(input, output, session) {
  
  output$mytable <- renderDT({
    df <- data.frame(
      x = 1:10000000, y = sample(letters, 10000000, replace = TRUE),
      stringsAsFactors = FALSE
    )
    df %>% datatable(
      options = list(
        initComplete = initComplete
      )
    )
  })
  
}

shinyApp(ui, server)

Вы также можете скрыть таблицу:

js <- "
$(document).on('preInit.dt', function(e, settings){
  $('#busy').show();
  $('#mytable').hide();
});
"

initComplete <- JS(
  "function(settings, json){",
  "  $('#busy').hide();",
  "  $('#mytable').show();",
  "}"
)

Вы можете найти лучшие счетчики с помощью Google, набрав "spinner gif" и поиск среди изображений.

EDIT

Вот способ, который работает для нескольких таблиц и не использует изображение GIF, счетчик полностью сделан в CSS.

library(shiny)
library(DT)    

js <- "
$(document).on('preInit.dt', function(e, settings){
  var api = new $.fn.dataTable.Api( settings );
  var $container = $(api.table().node()).closest('.datatables');
  $container.find('>:first-child').css('visibility','hidden');
  $container.prepend('<div class=\"loader\"></div>');
});
"

initComplete <- JS(
  "function(settings, json){",
  "  var $container = $(this.api().table().node()).closest('.datatables');",
  "  $container.find('.loader').remove();",
  "  $container.find('>:first-child').css('visibility', 'visible');",
  "}"
)

css <- "
.loader {
  position: relative;
  top: 60px;
  left: 50%;
  z-index: 1000;
  border: 16px solid #f3f3f3;
  border-radius: 50%;
  border-top: 16px solid #3498db;
  width: 120px;
  height: 120px;
  -webkit-animation: spin 2s linear infinite; /* Safari */
  animation: spin 2s linear infinite;
}

/* Safari */
@-webkit-keyframes spin {
  0% { -webkit-transform: rotate(0deg); }
  100% { -webkit-transform: rotate(360deg); }
}

@keyframes spin {
  0% { transform: rotate(0deg); }
  100% { transform: rotate(360deg); }
}
"

ui <- fluidPage(
  
  tags$head(
    tags$style(HTML(css)),
    tags$script(HTML(js))
  ),
  
  DTOutput("mytable"),
  br(),
  DTOutput("mytable2")
  
) 

server <- function(input, output, session) {
  
  output$mytable <- renderDT({
    df <- data.frame(
      x = 1:1000000, y = sample(letters, 1000000, replace = TRUE),
      stringsAsFactors = FALSE
    )
    df %>% datatable(
      options = list(
        initComplete = initComplete
      )
    )
  })
      
  output$mytable2 <- renderDT({
    df <- data.frame(
      x = 1:1000000, y = sample(letters, 1000000, replace = TRUE),
      stringsAsFactors = FALSE
    )
    df %>% datatable(
      options = list(
        initComplete = initComplete
      )
    )
  })
  
}

shinyApp(ui, server)

введите описание изображения здесь

Если вы предпочитаете использовать внешние файлы для кода JavaScript и кода CSS, сохраните содержимое строки js в файл загрузчик. js и содержимое строки css в файл загрузчик. css; сохраните эти два файла во вложенной папке www*1026* вашего приложения и в Shiny UI замените

  tags$head(
    tags$style(HTML(css)),
    tags$script(HTML(js))
  )

на

  tags$head(
    tags$link(href = "loader.css", rel = "stylesheet"),
    tags$script(src = "loader.js")
  )
...