CODEWITHSUNDEEP
rshinydt
user3245256
user3245256

Reputation: 1968

Conditional formatting of cells inside renderDataTable

I have a mini Shiny app that shows a tiny table that is editable by the user. I was wondering how to add the following functionality to this table:

Change the background for the whole row to yellow if the last cell of that row (column 'Comment') contains (among other things) the string “for yellow” but make the row green if the last cell contains the string "for green". Those two strings will never appear in the same cell together.

My current code (below) has an issue: if I have some other text in the "Comment" column - besides my target strings "for yellow" or "for green" - the formatting goes away. I'd like it to stay there even if other strings are also present in the text of the last cell.

Thank you so much!

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)

Upvotes: 0

Views: 1871

Answers (1)

St&#233;phane Laurent
St&#233;phane Laurent

Reputation: 84709

You can achieve what you want with the styleContain function below:

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'))

EDIT

The previous code does not work as expected if one uses two formatStyle. Here is a fix:

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'))

Upvotes: 1

Related Questions