Добавьте формат к конфликту данных с помощью кнопок действий в R блестящий

Question

Я использовал указания в этот другой вопрос , чтобы создать datatable с кнопками внутри.

Я добавил некоторое форматирование к вызову renderTable(), чтобы выделить желтым цветом motivation == 3

    output$data <- DT::renderDataTable(
      datatable(df$data) %>% formatStyle(
        'Motivation',
        target = 'row',
        backgroundColor = styleEqual(c(3), c('yellow'))
      ),
      server = FALSE, escape = FALSE, selection = 'none'
    )

Выделяет правильную строку:

Проблема заключается в том, что форматирование цветов портится с помощью кнопок. Я нахожу ту же проблему при попытке форматирования дат (datatable автоматически показывает их в UT C, и я хочу, чтобы они были по местному времени). Являются ли форматирование и кнопки внутри таблицы несовместимыми?

Я получаю следующее предупреждение

renderDataTable ignores ... arguments when expr yields a datatable object; see ?renderDataTable

Вот код для приложения:

library(shiny)
library(DT)

shinyApp(
  ui <- fluidPage(
    DT::dataTableOutput("data"),
    textOutput('myText')
  ),

  server <- function(input, output) {

    myValue <- reactiveValues(employee = '')

    shinyInput <- function(FUN, len, id, ...) {
      inputs <- character(len)
      for (i in seq_len(len)) {
        inputs[i] <- as.character(FUN(paste0(id, i), ...))
      }
      inputs
    }

    df <- reactiveValues(data = data.frame(

      Name = c('Dilbert', 'Alice', 'Wally', 'Ashok', 'Dogbert'),
      Motivation = c(62, 73, 3, 99, 52),
      Actions = shinyInput(actionButton, 5, 'button_', label = "Fire", onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ),
      stringsAsFactors = FALSE,
      row.names = 1:5
    ))


    output$data <- DT::renderDataTable(
      datatable(df$data) %>% formatStyle(
        'Motivation',
        target = 'row',
        backgroundColor = styleEqual(c(3), c('yellow'))
      ),
      server = FALSE, escape = FALSE, selection = 'none'
    )

    observeEvent(input$select_button, {
      selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
      myValue$employee <<- paste('click on ',df$data[selectedRow,1])
    })


    output$myText <- renderText({

      myValue$employee

    })

  }
)

Answer 1

Вы должны посмотреть на этот ответ . Применяя его совет к вашей проблеме, я перемещаю escape = FALSE, selection = 'none' в datatable(df$data), и это работает (вам нужно удалить server = FALSE, что не принимается в datatable):

    output$data <- DT::renderDataTable(
      datatable(df$data, escape = FALSE, selection = 'none') %>% formatStyle(
        'Motivation',
        target = 'row',
        backgroundColor = styleEqual(c(3), c('yellow'))
      )
    )

В случае, если Ответ, на который я ссылаюсь выше, удален (не знаю, может ли это быть), я также поместил его здесь:

Вы получаете эту ошибку, потому что вы возвращаете DT::datatable AND вы также указываете filter='top' в качестве одного из ... аргументов DT::renderDataTable. Поскольку сообщение пытается вам сказать, ... аргументы игнорируются, так как вы возвращаете DT::datatable. Это связано с тем, что аргументы ... предназначены для передачи конструктору DT:datatable.

Либо переместите filter='top' внутрь конструктора DT::datatable, либо верните data.frame, и filter='top будет использоваться, когда DT::renderDataTable создает DT::datatable с указанным data.frame.