Условное форматирование ячеек внутри renderDataTable - PullRequest
Новая
       10

Условное форматирование ячеек внутри renderDataTable

0 голосов
/ 20 марта 2020

У меня есть мини-приложение Shiny, которое показывает крошечную таблицу, редактируемую пользователем. Мне было интересно, как добавить следующие функции в эту таблицу:

Измените фон для всей строки на желтый, если последняя ячейка этой строки (столбец «Комментарий») содержит (среди прочего) строку « для желтого », но сделайте строку зеленой, если последняя ячейка содержит строку« для зеленого ». Эти две строки никогда не появятся в одной и той же ячейке вместе.

Мой текущий код (ниже) имеет проблему: если у меня есть какой-то другой текст в столбце «Комментарий» - помимо моих целевых строк «для желтого» или «для зеленого» - форматирование исчезает. Я бы хотел, чтобы он там оставался, даже если в тексте последней ячейки присутствуют и другие строки.

Большое вам спасибо! 

library(shiny)
library(shinydashboard)
library(DT)

# ________________________________________________________________________________________
### UI code ####

ui <- dashboardPage(
  dashboardHeader(title = "DataTable"),
  dashboardSidebar(),
  dashboardBody(
    box(title = "Edit and Export",
      DT::dataTableOutput("o_my_table", width = "600px")))
)

# _________________________________________________________________________________
### SERVER code ####

server <- function(input, output) {

  ### Generate an example table ####
  my_data <- data.frame(
    Order = 1:3, Name = c("John", "Mary", "Paul"),
    Date = as.Date(c("2020-03-01", "2020-03-5", "2020-03-06")),
    Amount = c(100, 150, 200), Paystatus = c("Yes", "No", "Yes"),
    Comment = c(NA, "for yellow", "for green"), stringsAsFactors = FALSE)

  ### Define datatable ####

  output$o_my_table <- DT::renderDataTable({

    datatable(my_data,
              extensions = "Buttons",         # for table export
              editable = list(target = "cell", disable = list(columns = 1)),
              options = list(dom = "Bfrtip",
                             autoWidth = FALSE,
                             buttons = list(
                               list(extend = 'excel',
                                    title = 'My Data',
                                    text = 'Export data',
                                    exportOptions = list(modifier = list(page = 'all')))),
                             columnDefs = list(list(width = "180px", targets = 1:3)))
    ) %>%
      formatStyle('Comment', target = 'row',
                  backgroundColor = styleEqual("for yellow", 'yellow')) %>% 
      formatStyle('Comment', target = 'row',
                  backgroundColor = styleEqual("for green", 'green'))

  })

  ### Define proxy datatable (needed for editable event) ####
  proxyTable_my_table <- dataTableProxy("o_my_table")

  ### Observe edit cell of table ####
  observeEvent(input$o_my_table_cell_edit, {

    info <- input$o_my_table_cell_edit
    i <- info$row # get row number
    j <- info$col # get column number
    v <- info$value

    # my_data dataframe is being updated:
    my_data[i, j] <<- v  # global assignment should be ok because my_data is inside our server
    replaceData(proxyTable_my_table, my_data, resetPaging = FALSE)
  })
}

# ________________________________________________________________________________________
### Return a Shiny app object ####
shinyApp(ui = ui, server = server)

1 Ответ

1 голос
/ 21 марта 2020

Вы можете достичь желаемого с помощью функции styleContain, указанной ниже: 

library(DT)

styleContain <- function(string, color){
  JS(sprintf("value === null || value.match(/\\b%s\\b/) === null ? '' : '%s'", 
             string, color))
}

my_data <- data.frame(
  Order = 1:3, Name = c("John", "Mary", "Paul"),
  Date = as.Date(c("2020-03-01", "2020-03-5", "2020-03-06")),
  Amount = c(100, 150, 200), Paystatus = c("Yes", "No", "Yes"),
  Comment = c(NA, "xxx for yellow", "for green"), stringsAsFactors = FALSE)

datatable(my_data) %>%
  formatStyle('Comment', target = 'row',
              backgroundColor = styleContain("for yellow", 'yellow'))

РЕДАКТИРОВАТЬ

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

library(DT)

styleContain <- function(string, color){
  JS(sprintf("value === null || value.match(/\\b%s\\b/) === null ? value : '%s'", 
             string, color))
}

my_data <- data.frame(
  Order = 1:3, Name = c("John", "Mary", "Paul"),
  Date = as.Date(c("2020-03-01", "2020-03-5", "2020-03-06")),
  Amount = c(100, 150, 200), Paystatus = c("Yes", "No", "Yes"),
  Comment = c(NA, "xxx for yellow", "for green"), stringsAsFactors = FALSE)

datatable(my_data) %>%
  formatStyle('Comment', target = 'row',
              backgroundColor = styleContain("for yellow", 'yellow')) %>%
  formatStyle('Comment', target = 'row',
              backgroundColor = styleContain("for green", 'green'))
...