Блог

Я пытаюсь объединить две функции, которые, по-видимому, плохо сочетаются друг с другом.

Из того, что я понял, играя с этим, вы можете либо управлять стилем определенного столбца с помощью formatStyle (передавая объект datatable), либо вы можете играть с контейнером, управлять заголовком столбцов и рассматривать дополнительные параметры (что работает очень хорошо). Я не могу справиться и с тем, и с другим. В идеале я хотел бы найти способ раскрасить столбец во второй версии того, что предоставляется.

В этом простом примере вы можете понять, что я имею в виду:

 library(shiny)
library(dplyr)
library(DT)

df <- data.frame(col1 = c("A", "B", "C", "D"),
                 col2 = c("aa", "bb", "cc", "dd"),
                 col3 = c(-1, 0, 1, 2),
                 stringsAsFactors = F)

ui <- fluidPage(h4("Version 1: color coded column"),
                DTOutput("table1"),
                br(),
                h4("Version 2: grouped columns"),
                DTOutput("table2"))

server <- function(input, output, session) {
  ### V1 - format style ##########################
  output$table1 <- renderDataTable({
    datatable(df) %>%
      formatStyle(columns = 3,
                  color = styleInterval(cuts = 0, values = c("red", "green")),
                  fontWeight = "bold")})

  ### V2 - container group cols ##################
  output$table2 <- renderDataTable(df, 
                                  container = htmltools::withTags(table(
                                    class = 'display',
                                    thead(
                                      tr(
                                        th(colspan = 2, 'Group 1'),
                                        th(colspan = 1, 'Group 2')),
                                      tr(
                                        lapply(c('Column 1', 'Column 2', 'Values'), th))))),
                                  options = list(pageLength = 10, autoWidth = TRUE),
                                  rownames = FALSE,
                                  filter= "bottom")
}
shinyApp(ui = ui, server = server)
 

На выходе получается

Редактировать

Хотя приведенный ниже ответ глубоко раскрывает суть того, что можно сделать, также верно, что существует простое решение, основанное на приведенном выше коде. Пока я пытался найти его, меня отвлекла ошибка, из-за которой оператор container был помещен вне datatable() функции.

Тогда рабочий код будет:

 library(shiny)
library(dplyr)
library(DT)

df <- data.frame(col1 = c("A", "B", "C", "D"),
                 col2 = c("aa", "bb", "cc", "dd"),
                 col3 = c(-1, 0, 1, 2),
                 stringsAsFactors = F)

ui <- fluidPage(h4("All in!"),
                DTOutput("table"))

server <- function(input, output, session) {
  ### V1 - format style ##########################
  output$table <- renderDataTable({
    datatable(df,
              container = htmltools::withTags(table(
                class = 'display',
                thead(
                  tr(
                    th(colspan = 2, 'Group 1'),
                    th(colspan = 1, 'Group 2')),
                  tr(
                    lapply(c('Column 1', 'Column 2', 'Values'), th))))),
              options = list(pageLength = 10, autoWidth = TRUE),
              rownames = FALSE,
              filter= "bottom") %>%
      formatStyle(columns = 3,
                  color = styleInterval(cuts = 0, values = c("red", "green")),
                  fontWeight = "bold")},
  )
}
shinyApp(ui = ui, server = server)
 

Спасибо всем!

вариант 1: отформатируйте ячейки с помощью HTML, прежде чем делать данные доступными:

 library(shiny)
library(dplyr)
library(DT)

df <- data.frame(col1 = c("A", "B", "C", "D"),
                 col2 = c("aa", "bb", "cc", "dd"),
                 col3 = c(-1, 0, 1, 2),
                 stringsAsFactors = F)

df <- mutate(df, col3 = if_else(
    col3 <=0, 
    paste0("<b style='color: red; float: right;'>", col3, "</b>"),
    paste0("<b style='color: green; float: right;'>", col3, "</b>")
))
ui <- fluidPage(h4("Version 2: grouped columns"), DTOutput("table2"))

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

    ### V2 - container group cols ##################
    output$table2 <- renderDataTable(df, 
                                     container = htmltools::withTags(table(
                                         class = 'display',
                                         thead(
                                             tr(
                                                 th(colspan = 2, 'Group 1'),
                                                 th(colspan = 1, 'Group 2')),
                                             tr(
                                                 lapply(c('Column 1', 'Column 2', 'Values'), th))))),
                                     options = list(pageLength = 10, autoWidth = TRUE),
                                     rownames = FALSE,
                                     escape = FALSE,
                                     filter= "bottom")
}
shinyApp(ui = ui, server = server)
 

Ключ в том, чтобы добавить escape = FALSE аргумент.

вариант 2: используйте обратные вызовы с возможностью передачи данных

Для этого вам необходимо знать javascript и продвинутые селекторы CSS.

 library(shiny)
library(dplyr)
library(DT)

df <- data.frame(col1 = c("A", "B", "C", "D"),
                 col2 = c("aa", "bb", "cc", "dd"),
                 col3 = c(-1, 0, 1, 2),
                 stringsAsFactors = F)



ui <- fluidPage(h4("Version 2: grouped columns"), DTOutput("table2"))
server <- function(input, output, session) {

    ### V2 - container group cols ##################
    output$table2 <- renderDataTable(
        datatable(
            df,
            container = htmltools::withTags(table(
                class = 'display',
                thead(
                    tr(
                        th(colspan = 2, 'Group 1'),
                        th(colspan = 1, 'Group 2')),
                    tr(
                        lapply(c('Column 1', 'Column 2', 'Values'), th))))),
            options = list(
                pageLength = 10, 
                autoWidth = TRUE,
                rowCallback = JS(
                "function(row, data, displayNum, displayIndex, dataIndex) {
                    var value=data[2]; 
                    $(row).find('td:nth-of-type(3)').css({
                        'font-weight':'bold',
                        'color':isNaN(parseFloat(value)) ? '' : value <= 0 ? "red" : "green"
                    });
                }"
                )
            ),
            rownames = FALSE,
            filter= "bottom"
        )
   )
}
shinyApp(ui = ui, server = server)
 

Примечание

1. data[2] , вот 2 колонка index - 1 . Например, здесь вы хотите отформатировать третий столбец, поэтому у вас есть 3 -1 = 2 . Javascript проиндексирован на 0, но R проиндексирован на 1. Вам нужно выполнить преобразование.
2. nth-of-type(3) это индекс ячейки в CSS. В этом случае номер индекса ячейки совпадает с индексом столбца в R. Здесь это означает, что нужно выбрать третью ячейку в этой строке.

Сравнение

опция 1 называется обработкой на стороне сервера, опция 2-обработкой на стороне клиента.

• на стороне сервера: обрабатывайте данные на компьютере, на котором вы размещаете свои блестящие приложения.
• на стороне клиента: процесс выполняется на компьютере, на котором пользователи открывают браузер.

Представьте, что у вас есть таблица с миллионами записей, и у вас есть много пользователей, которые одновременно открывают приложение. Ваш сервер должен обработать это форматирование для всех пользователей. Обработка такого объема данных не похожа на миллисекунды, которые у нас здесь есть, может быть, несколько секунд, и время обработки этого количества пользователей будет суммироваться. Ваш сервер будет перегружен.

Если вы используете обработку на стороне клиента, данные будут отправляться пользователям в том виде, в каком они есть, а затем их браузер отвечает за форматирование, что сокращает работу вашего сервера. Однако, если у пользователя компьютер с картофелем (плохая производительность), ему может потребоваться много времени для самостоятельной обработки.